﻿Option Strict On
Imports Microsoft.VisualBasic
Imports System.Text.RegularExpressions
Imports dooll.Config
Imports dooll.Common

Imports System.IO
Imports Newtonsoft.Json


Namespace UI
    Public Class IPage
        Inherits System.Web.UI.Page

        Protected mDataBase As Data.DataFactory
        Protected mCurPage As Integer
        Protected IsCheckLogin As Boolean = True
        Protected IsFilterString As Boolean = True          '是否过滤字串符
        Protected WebEnableCache As Boolean = True          '是否使用页面缓存
        Protected PageStartTime As DateTime = Now()         '页面开始时间
        Protected EnableWebCache As Boolean
        Protected IsXmlHttp As Boolean
        Protected Rules As RewriterRuleCollection
        Protected mMailErrMessage As String = String.Empty
        Protected mSmsErrMessage As String = String.Empty
        Protected mUploadCtrl As UploadControl

        REM 内部
        Private fnTemplatePath As String                    '模板路径
        Private fnRawHtmlFile As String                     '页面原文件
        Private mLabelInfo As LabelConfigInfo
        Private mSiteInfo As SiteInfo

        Private mLabelPath As String
        Private Const _USER As String = "__Passport__"
        Private mPassport As PassportInfo
        Private mCacheFileFullName As String
        Private ExistsWebCache As Boolean
        Private mAction As String
        Private mNavigator As System.Xml.XPath.XPathNavigator
        Private mHelper As New Object
        Private mUriKey As String
        Private mPageCharSet As String = "utf-8"


#Region "自定义属性"

        Protected ReadOnly Property SiteInfo() As SiteInfo
            Get
                If mSiteInfo Is Nothing Then
                    Dim mySiteConfigSetup As SiteConfigInfo = SiteConfig.Load()
                    Return mySiteConfigSetup.Item(Request.Url.Host)
                Else
                    Return mSiteInfo
                End If
            End Get
        End Property

        ''' <summary>
        ''' 绝对URL 带域名
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property AbsoluteUri() As String
            Get
                Dim Url As String
                Url = Request.RawUrl

                Dim uri As New UriBuilder(Request.Url)
                uri.Path = Url.Split(CChar("?"))(0)

                'Dim port As String = CStr(IIf(uri.Port = 80, "", (":" + CStr(uri.Port))))
                'Dim query As String = CStr(IIf(String.IsNullOrEmpty(uri.Query), "", ("?" + uri.Query)))
                DebugToLog(String.Concat("=========", Request.Url, "=========", Request.Url.Port))
                Return uri.ToString()
            End Get
        End Property


        Public Sub ToExcel(xmlStr As String)
            Response.ClearContent()
            Response.ClearHeaders()
            Response.ContentType = "application/ms-excel"
            Response.AddHeader("content-disposition", String.Concat("attachment;filename=", Now.ToString("yyyyMMddHHmmss"), ".xls"))
            Response.ContentEncoding = System.Text.Encoding.UTF8
            Response.Write(xmlStr) '//xmlStr为转换之后得到的XML字符串
            Response.Flush()
            Response.End()
            Response.Close()
        End Sub

        ''' <summary>
        ''' 上传控制属性
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property UploadCtrl() As UploadControl
            Get
                If mUploadCtrl Is Nothing Then

                    mUploadCtrl = New UploadControl

                    If String.IsNullOrEmpty(LabelInfo.AllowUploadTypes) Then
                        mUploadCtrl.AllowUploadTypes = AppConfigInfo.AllowUploadTypes
                    Else
                        mUploadCtrl.AllowUploadTypes = LabelInfo.AllowUploadTypes
                    End If

                    If LabelInfo.MaxUploadSize = 0 Then
                        mUploadCtrl.MaxUploadSize = AppConfigInfo.MaxUploadSize
                    Else
                        mUploadCtrl.MaxUploadSize = LabelInfo.MaxUploadSize
                    End If

                    If Not String.IsNullOrEmpty(LabelInfo.UploadPath) Then
                        mUploadCtrl.UploadPath = LabelInfo.UploadPath
                    Else
                        mUploadCtrl.UploadPath = AppConfigInfo.UploadPath
                    End If

                    If Not String.IsNullOrEmpty(LabelInfo.ThumbnailPath) Then
                        mUploadCtrl.ThumbnailPath = LabelInfo.ThumbnailPath
                    Else
                        mUploadCtrl.ThumbnailPath = AppConfigInfo.ThumbnailPath
                    End If

                    If LabelInfo.Thumbnail = "0" Then
                        mUploadCtrl.ThumbnailMode = 0
                    Else
                        Dim thum As String() = Split(LabelInfo.Thumbnail, ",")

                        If thum.Length = 3 Then
                            mUploadCtrl.ThumbnailMode = CInt(thum(0))
                            mUploadCtrl.ThumbnailWidth = CInt(thum(1))
                            mUploadCtrl.ThumbnailHeight = CInt(thum(2))
                        End If
                    End If

                    mUploadCtrl.Canvas = LabelInfo.Canvas
                    mUploadCtrl.MinCanvas = LabelInfo.MinCanvas
                    mUploadCtrl.Watermarkalpha = LabelInfo.Watermarkalpha
                    mUploadCtrl.Position = LabelInfo.Watermarkposition
                    mUploadCtrl.Quality = LabelInfo.Quality

                End If

                Return mUploadCtrl
            End Get
        End Property

        ''' <summary>
        ''' 支付配置信息
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property PaymentConfigInfo() As Payment.PaymentConfigInfo
            Get
                If Payment.PaymentConfig.ConfigInfo Is Nothing Then
                    Payment.PaymentConfig.load()
                End If
                Return Payment.PaymentConfig.ConfigInfo
            End Get
        End Property

        ''' <summary>
        ''' 程序配置信息
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property AppConfigInfo() As AppConfigInfo
            Get
                If AppConfig.ConfigInfo Is Nothing Then
                    AppConfig.load()
                End If
                Return AppConfig.ConfigInfo
            End Get
        End Property

        Protected ReadOnly Property UrlHost() As String
            Get
                If Request.Url.Port = 80 Then
                    Return Request.Url.Host
                Else
                    Return String.Concat(Request.Url.Host, ":", Request.Url.Port)
                End If
            End Get
        End Property

        ''' <summary>
        ''' 关键字记录模式
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property KWRecordMethod() As Integer
            Get
                If LabelInfo.KWRecordMethod = -1 Then
                    Return AppConfigInfo.KWRecordMethod
                End If
                Return LabelInfo.KWRecordMethod
            End Get
        End Property

        ''' <summary>
        ''' 关键字栏截模式
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property KWInterceptMethod() As Integer
            Get
                If LabelInfo.KWInterceptMethod = -1 Then
                    Return AppConfigInfo.KWInterceptMethod
                End If
                Return LabelInfo.KWInterceptMethod
            End Get
        End Property


        ''' <summary>
        ''' 数据库管理
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property DataBase() As Data.DataFactory
            Get
                If mDataBase Is Nothing Then
                    mDataBase = New Data.DataFactory(UriKey)
                End If
                Return mDataBase
            End Get
        End Property

        Protected ReadOnly Property UriKey() As String
            Get
                If String.IsNullOrEmpty(mUriKey) Then
                    Dim mHostItem As HostItem = HostsConfig.Hosts.Find(Request.Url.Host)
                    If Not mHostItem Is Nothing AndAlso Not String.IsNullOrEmpty(mHostItem.DSN) Then
                        mUriKey = mHostItem.DSN
                    Else
                        mUriKey = "default"
                    End If
                End If
                Return mUriKey
            End Get
        End Property

        ''' <summary>
        ''' 页面配置信息
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property LabelInfo() As LabelConfigInfo
            Get
                Return mLabelInfo
            End Get
        End Property

        ''' <summary>
        ''' 密码错误次数
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property PwdErrorTimes() As Integer
            Get
                Dim ErrorTimesCookie As HttpCookie = Request.Cookies("PwdErrorTime")
                If Not ErrorTimesCookie Is Nothing Then
                    Return CInt(ErrorTimesCookie.Value)
                End If
                Return 0
            End Get
        End Property

        ''' <summary>
        ''' 页面用户通行证信息
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overridable ReadOnly Property Passport() As PassportInfo
            Get
                If mPassport Is Nothing Then
                    If Request.Cookies.Item(AppConfigInfo.PassportCookie) Is Nothing Then

                        Dim tokenValue As String = Request.QueryString("Token")
                        If String.IsNullOrEmpty(tokenValue) OrElse Not tokenValue = "$Token$" Then
                            mPassport = New PassportInfo

                        Else
                            If LoadToken(tokenValue) Then
                                mPassport = New PassportInfo
                            End If
                        End If

                    Else
                        Try
                            REM 改成Cookie
                            Dim SessionCookie As HttpCookie = Request.Cookies.Item(AppConfigInfo.PassportCookie)
                            If Not SessionCookie Is Nothing AndAlso (Not String.IsNullOrEmpty(SessionCookie.Value)) Then
                                Dim cookieTokenValue As String = Common.Util.UnzipString(SessionCookie.Value)
                                mPassport = CType(JavaScriptConvert.DeserializeObject(cookieTokenValue, GetType(PassportInfo)), PassportInfo)
                            End If

                            'SessionCookie.Expires = Now().AddMinutes(Session.Timeout)
                            'Response.Cookies.Add(SessionCookie)
                            SessionCookie = Nothing
                        Catch ex As Exception
                            mPassport = New PassportInfo
                        End Try
                    End If

                End If
                Return mPassport

            End Get
        End Property

#Region "dooll页面通行证属性"


        Public Overridable ReadOnly Property doollPassport() As PassportInfo
            Get
                If mPassport Is Nothing Then
                    If Request.Cookies.Item(_USER) Is Nothing Then
                        mPassport = New PassportInfo
                    Else
                        Try
                            REM 改成Cookie
                            Dim SessionCookie As HttpCookie = Request.Cookies.Item(_USER)
                            mPassport = CType(JavaScriptConvert.DeserializeObject(SessionCookie.Value, GetType(PassportInfo)), PassportInfo)
                            'SessionCookie.Expires = Now().AddMinutes(Session.Timeout)
                            Response.Cookies.Add(SessionCookie)
                            SessionCookie = Nothing
                        Catch ex As Exception
                            mPassport = New PassportInfo
                        End Try
                    End If
                End If
                Return mPassport

            End Get
        End Property


#End Region

        ''' <summary>
        ''' 重写页面HTML
        ''' </summary>
        ''' <remarks></remarks>
        Protected Sub ReWriteHtmlFile()

            Dim ReferUrl As System.Uri = Request.UrlReferrer

            If ReferUrl Is Nothing OrElse String.IsNullOrEmpty(ReferUrl.AbsolutePath) Then
                Response.Status = "404 File not found"
                Response.End()
            End If
            If ReferUrl.AbsolutePath.EndsWith("/") Then
                tHtmlFile = String.Concat(ReferUrl.AbsolutePath, "default.html")
            Else
                tHtmlFile = ReferUrl.AbsolutePath
            End If
        End Sub

        ''' <summary>
        ''' 页面操作动作
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property uAction() As String
            Get
                If String.IsNullOrEmpty(mAction) Then
                    mAction = IO.Path.GetFileNameWithoutExtension(tHtmlFile)
                End If
                Return mAction
            End Get
        End Property

        ''' <summary>
        ''' 解析后的HTMLFILE属性
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected Property tHtmlFile() As String
            Get

                If String.IsNullOrEmpty(fnRawHtmlFile) Then

                    REM 此处用处修复兼容URL REWRITE 模块2.0的功能
                    fnRawHtmlFile = Request.ServerVariables("HTTP_X_ORIGINAL_URL")

                    If String.IsNullOrEmpty(fnRawHtmlFile) Then
                        fnRawHtmlFile = GetRealHtmlFile(Request.RawUrl)
                        If fnRawHtmlFile.EndsWith("/") Then
                            fnRawHtmlFile += "default.html"
                        End If
                    End If

                End If

                Return String.Format("{0}{1}", TemplatePath, fnRawHtmlFile)
            End Get
            Set(ByVal value As String)
                fnRawHtmlFile = GetRealHtmlFile(value)
            End Set
        End Property

        Protected Function GetRealHtmlFile(ByVal fnRawFile As String) As String

            If Rules Is Nothing Then ReWriteConfig.Load()

            If fnRawFile.IndexOf("?") > -1 Then
                fnRawFile = fnRawFile.Substring(0, fnRawFile.IndexOf("?"))
            End If

            Dim RuleInfo As dooll.Config.RewriterRule = Rules.Find(fnRawFile, UrlHost)
            If RuleInfo Is Nothing Then
                fnRawFile = Regex.Replace(fnRawFile, "/(?'1'[^.-]+)\-(?'2'[^.]*)\.html", "/$1.html", RegexOptions.IgnoreCase)
            Else
                fnRawFile = Regex.Replace(fnRawFile, RuleInfo.LookFor, RuleInfo.Page, RegexOptions.IgnoreCase)
            End If
            Return fnRawFile
        End Function

        ''' <summary>
        ''' 定义模板目录属性
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property TemplatePath() As String
            Get
                If fnTemplatePath Is Nothing Then
                    Dim fnHost As HostItem = HostsConfig.Hosts.Find(Request.Url.Host)
                    If fnHost Is Nothing Then
                        fnTemplatePath = HostsConfig.Hosts.DefaultPath
                    Else
                        fnTemplatePath = fnHost.Path
                    End If
                    fnHost = Nothing
                    'If Application.Item("_TemplatePath_") Is Nothing Then

                    REM 写application(_TemplatePath)
                    'Application.Lock()
                    'Application.Item("_TemplatePath_") = fnTemplatePath
                    'Application.UnLock()
                    'Else
                    'fnTemplatePath = CStr(Application.Item("_TemplatePath_"))
                    'End If
                End If

                Return fnTemplatePath

            End Get
        End Property

        ''' <summary>
        ''' 用户登录功能
        ''' </summary>
        ''' <param name="fnUserName"></param>
        ''' <param name="fnPassword"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected Overridable Function Login(ByVal fnUserName As String, ByVal fnPassword As String, token As String) As String

            If String.IsNullOrEmpty(fnUserName) OrElse String.IsNullOrEmpty(fnPassword) Then Return Util.ReturnValue("101", "请先填写用户名和密码(长度不够)!")

            Try
                Dim PM As New PassportManage(UriKey)
                Dim ErrCode = PM.Login(fnUserName, fnPassword, Request.ServerVariables("REMOTE_ADDR"), xSessionID(), mPassport, token)
                Dim ErrTimesCookie As HttpCookie
                If mPassport Is Nothing Then
                    Return Util.ReturnValue("-500", PM.ErrMessage)
                ElseIf Not mPassport.IsLogin Then
                    ErrTimesCookie = New HttpCookie("PwdErrorTime", CStr(PwdErrorTimes + 1))
                    ErrTimesCookie.Expires = Now.AddMinutes(5)
                    Response.Cookies.Add(ErrTimesCookie)
                    ErrTimesCookie = Nothing
                    Return Util.ReturnValue("-1", PM.ErrMessage)
                Else
                    ErrTimesCookie = Request.Cookies("PwdErrorTime")
                    If Not ErrTimesCookie Is Nothing Then
                        ErrTimesCookie.Expires = Now.AddDays(-100)
                        Response.Cookies.Add(ErrTimesCookie)
                        ErrTimesCookie = Nothing
                    End If
                    Dim tokenInfo As String
                    tokenInfo = JavaScriptConvert.SerializeObject(mPassport)

                    If Not SavePassportCookie(tokenInfo) Then
                        Response.Clear()
                        Response.Write(Util.ReturnValue("500", "无法写入Cookie"))
                        Response.End()
                    End If

                    Return Util.ReturnValue("0", "登录成功")
                End If
                PM = Nothing
            Catch ex As Exception
                Return Util.ReturnValue("-100", ex.Message)
            End Try

        End Function

        ''' <summary>
        ''' 生成本地的通行证Cookie
        ''' </summary>
        ''' <param name="tokenInfo">通行证内容</param>
        ''' <returns>是否写入成功</returns>
        ''' <remarks></remarks>
        Protected Function SavePassportCookie(ByVal tokenInfo As String) As Boolean
            Dim returnValue As Boolean = False
            Try
                '令牌正确 授权访问该页面！
                Dim PaCookie As HttpCookie = New HttpCookie(AppConfigInfo.PassportCookie)   '_Token_ 请替换成LoginPassportCookie
                PaCookie.Path = "/"
                PaCookie.HttpOnly = False
                PaCookie.Value = Common.Util.ZipString(tokenInfo)
                Response.Cookies.Add(PaCookie)
                returnValue = True
            Catch ex As Exception
                Return False
            End Try
            Return returnValue
        End Function

        ''' <summary>
        ''' 退出系统
        ''' </summary>
        ''' <param name="toUrl"></param>
        ''' <remarks></remarks>
        Protected Overridable Sub LogOut(ByVal toUrl As String)

            Dim PaCookie As HttpCookie = Request.Cookies(AppConfigInfo.PassportCookie)
            Dim Token As String = Passport.Token

            If Not PaCookie Is Nothing Then
                PaCookie.Expires = Now.AddDays(-1)
                PaCookie.Path = "/"
                PaCookie.Value = String.Empty
                Response.Cookies.Add(PaCookie)
                PaCookie = Nothing
            End If

            If Util.AppSettings("ssopassport") <> "0" Or AppConfigInfo.PassportSSO Then

                Try
                    Dim TokenService As New passport.net.TokenService
                    If Not TokenService Is Nothing Then
                        TokenService.ClearToken(Token)
                        TokenService = Nothing
                    End If
                Catch ex As Exception

                End Try

            End If

            If Not String.IsNullOrEmpty(toUrl) Then
                toUrl = Regex.Replace(toUrl, "(\?|&)Token=([^&]*)", "", RegexOptions.IgnoreCase)
                Response.Redirect(toUrl)
            Else
                Dim referer As String = Request.ServerVariables("HTTP_REFERER")
                referer = Regex.Replace(referer, "(\?|&)Token=([^&]*)", "", RegexOptions.IgnoreCase)
                If Not String.IsNullOrEmpty(referer) AndAlso referer <> Request.Url.AbsoluteUri Then
                    Response.Redirect(referer)
                End If
            End If

            Response.Write(Util.ReturnValue("0", "你已经成功退出系统!"))
            Response.End()
        End Sub

        ''' <summary>
        ''' 当前页码
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property PageNumber() As Integer
            Get
                If mCurPage = 0 Then
                    If String.IsNullOrEmpty(Request.QueryString("page")) Then
                        mCurPage = 1
                    Else
                        Try
                            mCurPage = CType(Request.QueryString("page"), Integer)
                        Catch ex As Exception
                            mCurPage = 1
                        End Try
                    End If
                End If
                Return mCurPage
            End Get
        End Property

        ''' <summary>
        ''' 缓存目录
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected ReadOnly Property CachePath() As String
            Get
                Return AppConfigInfo.CachePath
            End Get
        End Property

        ''' <summary>
        ''' 缓存文件名
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property CacheFileFullName() As String
            Get
                If mCacheFileFullName Is Nothing Then
                    mCacheFileFullName = Server.MapPath(String.Format("{0}\{1}\{2}", CachePath, Request.Url.Host, Path.ChangeExtension(Request.RawUrl.Split(CChar("?"))(0), AppConfigInfo.CacheFileExtName)))
                End If
                Return mCacheFileFullName
            End Get
        End Property

        ''' <summary>
        ''' 返回标签路径
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property LabelPath() As String
            Get
                If String.IsNullOrEmpty(mLabelPath) Then
                    mLabelPath = String.Format("{0}\{1}\", IO.Path.GetDirectoryName(tHtmlFile), IO.Path.GetFileNameWithoutExtension(tHtmlFile))
                End If
                Return mLabelPath
            End Get

        End Property

        ''' <summary>
        ''' 页面配置信息
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property LabelConfigFile() As String
            Get
                Dim Uri As String = Server.MapPath(String.Format("{0}label.config", LabelPath))
                If IO.File.Exists(Uri) Then
                    Return Uri
                End If
                Return Server.MapPath(String.Format("{0}label.xml", LabelPath))
            End Get
        End Property

#End Region

#Region "模块加载功能区"

        REM 读取指定URL和KEY的HtmlData
        Protected Function getHtmlData(ByVal fnKey As String) As String

            Dim iCT As Integer = 0
            Dim sPara As String = String.Empty

            If Not String.IsNullOrEmpty(Request.QueryString("cachetime")) Then iCT = CType(Request.QueryString("cachetime"), Integer)

            If Not String.IsNullOrEmpty(Request.QueryString("param")) Then sPara = Request.QueryString("param")

            Return LoadList(fnKey, iCT, sPara)

        End Function


        REM 解析Label_List标签
        Protected Function ReplaceLabel(ByVal fnOutHtml As String) As StringBuilder
            Return ReplaceLabel(New StringBuilder(fnOutHtml))
        End Function

        Protected Function ReplaceLabel(ByRef sb As StringBuilder) As StringBuilder
            Dim sparam As String
            Dim iCacheTime As Integer = 0
            For Each m As Match In Regex.Matches(sb.ToString, "<(?:city_list|city:list)(?:\s*|\s+cache=\""(?'2'\d+)\"")(?:\s*|\s+param=\""(?'3'[^\""\>]*)\"")\s*>(?'1'[^<]*)<\/(?:city_list|city:list)>", RegexOptions.IgnoreCase)
                iCacheTime = 0
                If String.IsNullOrEmpty(m.Groups.Item(2).Value) OrElse Not IsNumeric(m.Groups.Item(2).Value) Then
                    iCacheTime = 0
                Else
                    iCacheTime = CType(m.Groups.Item(2).Value, Integer)
                End If
                If m.Groups.Item(3).Value.Length = 0 Then
                    sparam = ""
                Else
                    sparam = m.Groups.Item(3).Value
                End If
                sb.Replace(m.Value, LoadList(m.Groups.Item(1).Value, iCacheTime, sparam))
            Next
            Return sb
        End Function

#End Region

#Region "加载City:List列表功能"


        REM 加载CITY:LIST列表
        Protected Function LoadList(ByVal fnKey As String) As String
            Return LoadList(fnKey, 0, "")
        End Function

        REM 加载CITY:LIST列表
        Protected Function LoadList(ByVal fnKey As String, ByVal fnCacheMinute As Integer, ByVal fnParam As String, Optional xsltstring As String = "") As String
            Dim fnStartTime As DateTime = DateTime.Now
            Dim fnOutHtml As String = String.Empty
            Dim strOrderby As String = String.Empty
            Dim iRowCount As Long = 0
            Dim ListItem As LabelItem = LabelInfo.Find(fnKey)

            Dim xPathDoc As System.Xml.XPath.XPathDocument = Nothing
            Dim iMaxRowEveryPage As Integer = 0
            Dim strWhere As String = String.Empty

            If ListItem Is Nothing Then
                Return String.Format("[{0}]!!!", fnKey)
            End If

            REM 检查权限
            If Not String.IsNullOrEmpty(ListItem.ACL) Then
                Dim Err As String = String.Empty
                If Not ChkLabelItemACL(ListItem.ACL, fnKey, Err) Then
                    Return Err
                End If
            End If

            If String.IsNullOrEmpty(ListItem.Paramaters) And Not ListItem.Table Is Nothing Then

                Select Case ListItem.Table.type

                    Case "function"
                        Dim checkparam As String = String.Empty
                        Dim SqlParams() As System.Data.Common.DbParameter = GetStroeProcParam(ListItem.Table.Param, fnParam, checkparam)
                        If Not String.IsNullOrEmpty(checkparam) AndAlso LCase(checkparam) <> "true" Then
                            Return checkparam
                        End If

                        Dim functionReturn As String = DataBase.ExecuteFunction(ListItem.Table.Name, SqlParams)
                        If functionReturn.StartsWith("-500.") Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                            Return Util.ReturnValue("-500", Replace(DataBase.ErrMessage, ",", "，"))
                        Else
                            Return functionReturn
                        End If

                    Case "proc"
                        Dim checkparam As String = String.Empty

                        Dim SqlParams() As System.Data.Common.DbParameter = GetStroeProcParam(ListItem.Table.Param, fnParam, checkparam, strWhere)
                        If Not String.IsNullOrEmpty(checkparam) AndAlso LCase(checkparam) <> "true" Then
                            Return checkparam
                        End If
                        If DataBase.ExecuteProduce(ListItem.Table.Name, SqlParams, xPathDoc) = -500 Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                            Return Util.ReturnValue("-500", Replace(DataBase.ErrMessage, ",", "，"))
                        End If

                    Case "table"
                        Dim TableName As String = ListItem.Table.Name
                        Dim Query As String = ListItem.Table.Query

                        strWhere = GetTableWhere(ListItem.Table.Where, fnParam)

                        DebugToLog(String.Concat("where -", ListItem.Name, strWhere))

                        strOrderby = ListItem.Table.OrderBy

                        If Not String.IsNullOrEmpty(ListItem.Variables) Then
                            ReplaceRequestString(strOrderby)
                            InputVariables(strOrderby, ListItem.Variables)
                        End If
                        If Not String.IsNullOrEmpty(ListItem.Table.MaxOnPage) Then
                            Dim mR As String = ListItem.Table.MaxOnPage
                            ReplaceRequestString(mR)
                            iMaxRowEveryPage = CInt(mR)
                        End If

                        iRowCount = DataBase.XQuery(TableName, iMaxRowEveryPage, PageNumber, Query, strOrderby, strWhere, xPathDoc)
                        If iRowCount < 0 Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                            Return Util.ReturnValue(CStr(iRowCount), DataBase.ErrMessage)
                        End If
                    Case Else

                        Return String.Format("{0}, 对不起！未识别的类型{1}！", 500, ListItem.Table.type)
                End Select
            Else

                If String.IsNullOrEmpty(ListItem.Paramaters) Then
                    Return String.Format("{0}, 对不起！无效的参数设定！", 501, fnKey)
                End If

                REM 加载页面请求的参数
                ReplaceRequestString(ListItem.Paramaters)

                If Not String.IsNullOrEmpty(ListItem.Variables) Then
                    ReplaceRequestString(ListItem.Variables)
                    REM 替换所定义的变量值 $X
                    InputVariables(ListItem.Paramaters, ListItem.Variables)
                End If


                Dim aParamaters() As String = Split(CheckParamaters(ListItem.Paramaters, fnParam), "|")

                Dim QueryTable As String = aParamaters(0)



                REM 读取缓存处理
                Dim CacheName As String = String.Format("{0}_{1}", Replace(ListItem.Paramaters, " ", "_"), PageNumber)
                Dim CacheComment As String

                If fnCacheMinute > 0 AndAlso Not Cache(CacheName) Is Nothing Then
                    xPathDoc = CType(Cache(CacheName), System.Xml.XPath.XPathDocument)
                    CacheComment = String.Format("<!--读取CACHE({0})-time({1})-->", CacheName, fnCacheMinute)
                Else

                    If aParamaters.Length > 4 Then
                        strWhere = aParamaters(4)
                    End If
                    Try
                        Dim RuleString As String = "^{SP:([a-zA-Z_0-9._]+)}"
                        If Regex.IsMatch(QueryTable, RuleString, RegexOptions.IgnoreCase) Then '判断是否为存储过程

                            DataBase.ExecuteProduce(Regex.Match(QueryTable, RuleString, RegexOptions.IgnoreCase).Groups.Item(1).Value(), aParamaters, xPathDoc)
                        Else
                            If Not IsNumeric(aParamaters(1)) Then
                                Return String.Format("{0},(Page)类型错误,必须是数字", 501)
                            End If
                            iRowCount = DataBase.XQuery(QueryTable.Trim(), CType(aParamaters(1), Integer), PageNumber, aParamaters(2).ToString, aParamaters(3).ToString, strWhere, xPathDoc)
                            If iRowCount = -500 Then
                                Return String.Format("{0},{1}", -500, DataBase.ErrMessage)
                            End If
                            iMaxRowEveryPage = CType(aParamaters(1), Integer)
                            strOrderby = aParamaters(3).ToString
                        End If
                    Catch ex As Exception
                        DebugToLog(String.Concat("500", ListItem.Name, ex.Message))
                        Return String.Format("{0},<font color='#FF0000'>(LoadList)Error Load DataBase:{1}.</font>", 500, ex.Message)
                    End Try

                    REM 生成或清除缓存
                    If fnCacheMinute > 0 Then
                        Cache.Insert(CacheName, xPathDoc, Nothing, DateTime.Now.AddMinutes(fnCacheMinute), Caching.Cache.NoSlidingExpiration)
                    Else
                        Cache.Remove(CacheName)
                    End If

                End If

            End If

            Dim XsltStr As StringBuilder, XsltFilePath As String = String.Empty

            '是否外部引入xslt数据，主要用于文章预览
            If String.IsNullOrEmpty(xsltstring) Then
                '是否读取xslt模块
                If Not String.IsNullOrEmpty(ListItem.XsltModule) Then
                    Dim s As String = loadCmsModule(ListItem.XsltModule)
                    XsltStr = New StringBuilder(s)
                Else
                    REM 加载XSLT 文档内容
                    If String.IsNullOrEmpty(ListItem.XsltStyle) Then
                        Return xPathDoc.CreateNavigator.OuterXml.ToString
                    Else


                        If ListItem.XsltStyle.StartsWith("/") Then
                            XsltFilePath = Server.MapPath(ListItem.XsltStyle)
                        Else
                            XsltFilePath = Server.MapPath(String.Concat(LabelPath, ListItem.XsltStyle))
                        End If

                        If Not IO.File.Exists(XsltFilePath) Then
                            Return String.Format("{0},不存在[{1}]", 404, ListItem.XsltStyle)
                        End If
                        Dim str As String = IO.File.ReadAllText(XsltFilePath)
                        'If mPageCharSet <> "utf-8" Then
                        '    Dim space As Byte() = New Byte() {&HC2, &HA0}
                        '    Dim UTFSpace As String = Encoding.GetEncoding("UTF-8").GetString(space)
                        '    str = str.Replace(UTFSpace, "&nbsp;")
                        'End If
                        XsltStr = New StringBuilder(str)
                    End If
                End If
            Else
                XsltStr = New StringBuilder(xsltstring)
            End If

            Try

                REM 加载XmlDocument的运行参数
                'XsltStr.Replace("{ROWCOUNT}", iRowCount.ToString)
                'XsltStr.Replace("{MAXROW}", iMaxRowEveryPage.ToString)
                'XsltStr.Replace("{CURPAGE}", CStr(PageNumber))
                'XsltStr.Replace("{PARAM}", fnParam)
                'XsltStr.Replace("{TEMPLATENAME}", fnKey)
                'XsltStr.Replace("{ORDERBY}", strOrderby)
                'XsltStr.Replace("{WHERE}", strWhere)
                'XsltStr.Replace("{RUNTIME}", ((DateTime.Now - fnStartTime).TotalMilliseconds / 1000).ToString)

                LoadInclude(XsltStr)

                If xPathDoc Is Nothing Then
                    DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                    fnOutHtml = String.Format("数据库操作失败！！原因：{0}", DataBase.ErrMessage)
                Else
                    Dim XsltArgList As System.Xml.Xsl.XsltArgumentList = GetXsltArgList()
                    XsltArgList.AddParam("rowcount", String.Empty, CStr(iRowCount))
                    XsltArgList.AddParam("maxrow", String.Empty, CStr(iMaxRowEveryPage))
                    XsltArgList.AddParam("curpage", String.Empty, CStr(PageNumber))
                    XsltArgList.AddParam("templatename", String.Empty, fnKey)
                    XsltArgList.AddParam("orderby", String.Empty, CStr(strOrderby))
                    XsltArgList.AddParam("where", String.Empty, CStr(strWhere))

                    If Not String.IsNullOrEmpty(fnParam) Then
                        '是否多参数导入模式
                        If fnParam.IndexOf("=") = -1 Then
                            XsltArgList.AddParam("param", String.Empty, fnParam)
                        Else
                            Dim params As NameValueCollection = StrToDict(fnParam)
                            For Each k As String In params.Keys
                                If Not String.IsNullOrEmpty(k) Then
                                    XsltArgList.RemoveParam(k, String.Empty)
                                    XsltArgList.AddParam(k, String.Empty, params(k))
                                End If
                            Next
                        End If
                    End If

                    XsltArgList.AddParam("runtime", String.Empty, CStr((DateTime.Now - fnStartTime).TotalMilliseconds / 1000))
                    fnOutHtml = XsltCompiled.XmlTrans(xPathDoc, XsltStr.ToString, XsltArgList, XsltFilePath, AppConfigInfo.XsltCacheTime)
                    XsltArgList = Nothing
                End If

                XsltStr = Nothing

            Catch ex As Exception
                DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                Return String.Format("{0},<font color='#FF0000'>(LoadList)XSLT解析错误:{1}.</font>", 500, ex.Message)

            End Try

            xPathDoc = Nothing
            ListItem = Nothing

            Return fnOutHtml

        End Function

        ''' <summary>
        ''' 字符串转NameValueCollection
        ''' </summary>
        ''' <param name="s">字符串</param>
        ''' <param name="split"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function StrToDict(s As String, Optional split As String = "|") As NameValueCollection
            If String.IsNullOrEmpty(s) Then Return Nothing
            Dim params As String() = s.Split(CChar(split))
            Dim nv As New NameValueCollection
            For i As Integer = 0 To params.Length - 1
                Dim a As String() = params(i).Split(CChar("="))
                If a.Length = 2 Then
                    nv.Add(a(0), a(1))
                End If
            Next
            Return nv
        End Function


        ''' <summary>
        ''' 创建一个xslt参数列表对象
        ''' </summary>
        ''' <param name="ht">附加参数,Hashtable对象</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected Function GetXsltArgList(Optional ByVal ht As Hashtable = Nothing) As System.Xml.Xsl.XsltArgumentList
            If ht Is Nothing Then ht = New Hashtable
            Dim XsltArgList As New System.Xml.Xsl.XsltArgumentList
            XsltArgList.AddExtensionObject("urn:page", Me)
            XsltArgList.AddExtensionObject("urn:passport", Passport)
            For Each de As DictionaryEntry In ht
                XsltArgList.AddParam(CStr(de.Key), String.Empty, de.Value)
            Next
            Return XsltArgList
        End Function

        Protected Sub InputVariables(ByRef params As String, ByVal variables As String)
            If Not String.IsNullOrEmpty(variables) Then
                Dim VarArray() As String = variables.Split(CChar("|"))
                For I As Integer = VarArray.Length - 1 To 0 Step -1
                    params = params.Replace(String.Concat("$", I), VarArray(I))
                Next
            End If
        End Sub

        REM 验证Label.xml Item 的权限
        Protected Overridable Function ChkLabelItemACL(ByVal acl As String, ByVal fnKey As String, ByRef ErrMessage As String) As Boolean
            Return ChkLabelItemACL(acl, fnKey, ErrMessage, Request.QueryString)
        End Function

        Protected Overridable Function ChkLabelItemACL(ByVal acl As String, ByVal fnKey As String, ByRef ErrMessage As String, ByVal RequestObj As NameValueCollection) As Boolean
            Select Case acl
                Case "1"
                    If Not Passport.IsLogin Then
                        ErrMessage = String.Format("{0},对不起!!!您未登录或没有权限使用[{1}].\n{2}.]!!!", 403, fnKey, tHtmlFile)
                        Return False
                    Else
                        Return True
                    End If
                Case "2"
                    If Not ChkVaidCode() Then
                        ErrMessage = String.Format("{0},程序要求验证码!!!", 103)
                        Return False
                    Else
                        Return True
                    End If
                Case Else
                    ErrMessage = String.Format("{0},找不到{2}的权限[{1}]!!!", 403, acl, fnKey)
                    Return False
            End Select
        End Function

#End Region

#Region "替换Request请求"

        REM 替换所有请求
        Protected Overridable Function ReplaceRequestString(ByRef s As String) As String
            s = ReplaceRequestString(New StringBuilder(s))
            Return s
        End Function

        Protected Overridable Function ReplaceRequestString(ByRef sb As StringBuilder) As String
            ReplaceString(sb, True)
            ReplaceLoginString(sb)
            Return sb.ToString
        End Function

        Protected Overridable Function ReplaceString(ByRef sb As StringBuilder) As String
            Return ReplaceString(sb, True)
        End Function

        ''' <summary>
        ''' 关键字过滤
        ''' </summary>
        ''' <param name="method">1 get,2 post</param>
        ''' <param name="str">查询的关键字</param>
        ''' <remarks></remarks>
        Protected Sub DoKWFilter(method As Integer, ByVal str As String)
            Dim m As Match
            If String.IsNullOrEmpty(str) Then Return
            str = Regex.Replace(str, "[^\u4e00-\u9fa5]+", "")
            If (KWRecordMethod And method) = method And Not String.IsNullOrEmpty(AppConfigInfo.KWRecord) Then
                m = Regex.Match(str, String.Concat("(", AppConfigInfo.KWRecord, ")"), RegexOptions.IgnoreCase)
                If m.Success Then
                    Util.toLog(Server.MapPath(String.Concat("/log/record/", Now.ToString("yyyyMMdd"), ".txt")), String.Concat(Now.ToString(), " 记录非法关键字: ", m.Value))
                End If
            End If

            If (KWInterceptMethod And method) = method And Not String.IsNullOrEmpty(AppConfigInfo.KWIntercept) Then
                m = Regex.Match(str, String.Concat("(", AppConfigInfo.KWIntercept, ")"), RegexOptions.IgnoreCase)
                If m.Success Then
                    Util.toLog(Server.MapPath(String.Concat("/log/intercept/", Now.ToString("yyyyMMdd"), ".txt")), String.Concat(Now.ToString(), " 拦截非法关键字: ", m.Value))
                    Response.Write(String.Concat("900,拦截非法关键字(", m.Value, ")"))
                    Response.End()
                End If
            End If

        End Sub

        ''' <summary>
        ''' 替换通用请求s
        ''' </summary>
        ''' <param name="sb"></param>
        ''' <param name="bFilterSqlLabel"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected Overridable Function ReplaceString(ByRef sb As StringBuilder, ByVal bFilterSqlLabel As Boolean) As String
            Dim options As RegexOptions = RegexOptions.IgnoreCase

            Dim fnMatchs As MatchCollection

            REM 当前时间
            fnMatchs = Regex.Matches(sb.ToString(), "{(?'1'$$|SESSIONID|RAWURL|UACTION)}", options)
            For Each m As Match In fnMatchs
                Select Case m.Groups.Item(1).Value
                    Case "SESSIONID"
                        sb.Replace(m.Value, xSessionID())
                    Case "$$"
                        sb.Replace(m.Value, CStr(Passport.UserID))
                    Case "PAGE"
                        sb.Replace(m.Value, CStr(PageNumber))
                    Case "RAWURL"
                        sb.Replace(m.Value, Request.RawUrl)
                    Case "UACTION"
                        sb.Replace(m.Value, uAction)
                End Select
            Next

            REM 当前时间
            fnMatchs = Regex.Matches(sb.ToString(), "{now:?(?'1'[^}]*)}", options)
            For Each m As Match In fnMatchs
                If Not String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                    sb.Replace(m.Value, DateTime.Now.ToString(m.Groups.Item(1).Value))
                Else
                    sb.Replace(m.Value, DateTime.Now.ToString())
                End If
            Next


            Dim tmpStr As String = String.Empty
            fnMatchs = Regex.Matches(sb.ToString(), "{(?'1'request|form|config|server|cookie|siteconfig|in):(?'2'\w+):?(?'3'[^{}]*)}", options)
            For Each m As Match In fnMatchs
                REM 如果标头不存在
                If String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                    Continue For
                End If

                Select Case m.Groups.Item(1).Value
                    Case "request"
                        tmpStr = xRequest(m.Groups.Item(2).Value, m.Groups.Item(3).Value)

                    Case "form"
                        tmpStr = xForm(m.Groups.Item(2).Value, m.Groups.Item(3).Value)

                    Case "file"
                        If Not String.IsNullOrEmpty(m.Groups.Item(3).Value) AndAlso IsNumeric(m.Groups.Item(3).Value) Then
                            xFile(m.Groups.Item(2).Value, CInt(m.Groups.Item(3).Value))
                        Else
                            xFile(m.Groups.Item(2).Value)
                        End If

                    Case "config" REM Web.Config配置信息
                        Try
                            xConfig(m.Groups.Item(2).Value, m.Groups.Item(3).Value)
                        Catch ex As Exception
                            tmpStr = String.Empty
                        End Try
                    Case "siteconfig" REM SiteConfig配置信息
                        Try
                            tmpStr = xSiteConfig(m.Groups.Item(2).Value, m.Groups.Item(3).Value)
                        Catch ex As Exception
                            tmpStr = String.Empty
                        End Try

                    Case "server" REM 读取ServerVariables值
                        Try
                            tmpStr = xServer(m.Groups.Item(2).Value)
                        Catch ex As Exception
                            tmpStr = m.Groups.Item(2).Value + "无效"
                        End Try

                    Case "cookie" REM Cookie值

                        tmpStr = xCookie(m.Groups.Item(2).Value, m.Groups.Item(3).Value)

                    Case Else REM 空值
                        tmpStr = String.Empty
                End Select
                sb.Replace(m.Value, tmpStr)
            Next

            REM 加密|解密|urlcode
            fnMatchs = Regex.Matches(sb.ToString, "{(?'1'decrypt|encrypt|urlcode):(?'2'[^}]*)}", options)

            For Each m As Match In fnMatchs
                REM 如果标头不存在
                If String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                    Continue For
                End If
                Try
                    Select Case m.Groups.Item(1).Value.ToLower
                        Case "decrypt"
                            sb.Replace(m.Value, StringFilter(Util.Decrypt(m.Groups.Item(2).Value)))
                        Case "encrypt"
                            sb.Replace(m.Value, StringFilter(Util.Encrypt(m.Groups.Item(2).Value)))
                        Case "urlcode"
                            sb.Replace(m.Value, StringFilter(Server.UrlEncode(m.Groups.Item(2).Value)))
                    End Select
                Catch ex As Exception
                    sb.Replace(m.Value, m.Groups.Item(2).Value)
                End Try
            Next

            fnMatchs = Nothing

            If Regex.IsMatch(sb.ToString, "[\x00-\x08\x0b-\x0c\x0e-\x1f]") Then
                sb.Replace(sb.ToString, Text.XmlFilter(sb.ToString))
            End If
            Return sb.ToString
        End Function

        REM 替换身份请求
        Protected Overridable Function ReplaceLoginString(ByRef sb As StringBuilder) As String
            Dim options As RegexOptions = RegexOptions.Compiled Or RegexOptions.IgnoreCase
            Dim tmpStr As String = String.Empty

            For Each m As Match In Regex.Matches(sb.ToString(), "{(?'1'login):(?'2'\w+):?(?'3'[^{}]*)}", options)
                REM 如果标头不存在
                If String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                    Continue For
                End If
                Select Case m.Groups.Item(1).Value
                    Case "login" REM 登录信息
                        tmpStr = xLogin(m.Groups.Item(2).Value)
                        If String.IsNullOrEmpty(tmpStr) AndAlso Not String.IsNullOrEmpty(m.Groups.Item(3).Value) Then
                            tmpStr = m.Groups.Item(3).Value
                        End If
                    Case Else
                        tmpStr = String.Empty
                End Select
                sb.Replace(m.Value, tmpStr)
            Next
            options = Nothing

            Return sb.ToString

        End Function

        Protected Overridable Function ReplaceCmsLabel(ByRef sb As StringBuilder) As String
            Dim pb As New CMS.Publish(UriKey)
            pb.ReplaceCmsLabel(sb, GetXsltArgList)
            pb = Nothing
            Return sb.ToString
        End Function

        Protected Overridable Function ReplaceCmsField(ByRef sb As StringBuilder, ByVal ds As DataSet) As String
            Return ReplaceCmsField(sb, ds.Tables(0))
        End Function

        Protected Overridable Function ReplaceCmsField(ByRef sb As StringBuilder, ByVal dt As DataTable) As String
            Return ReplaceCmsField(sb, dt.Rows(0))
        End Function

        Protected Overridable Function ReplaceCmsField(ByRef sb As StringBuilder, ByVal dr As DataRow) As String
            Dim fnMatchs As MatchCollection = Regex.Matches(sb.ToString, "<cms_field>(?<name>\d+)</cms_field>", RegexOptions.IgnoreCase)
            Dim fieldname As String
            For Each m As Match In fnMatchs
                fieldname = m.Groups("name").Value
                If Not String.IsNullOrEmpty(fieldname) AndAlso Not dr.Item(fieldname) Is Nothing Then
                    sb.Replace(m.Value, CStr(dr.Item(fieldname)))
                End If
            Next
            Return sb.ToString
        End Function


        ''' <summary>
        ''' 加载cms模块
        ''' </summary>
        ''' <param name="mName"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Protected Overridable Function loadCmsModule(ByVal mName As String) As String
            If String.IsNullOrEmpty(mName) Then
                mName = "default"
            End If
            Dim rtnValue As String = String.Empty
            If DataBase.ExecuteScalar("sp_cms_moduleselect", DataBase.ConvertParam({"key=" + mName}), rtnValue) = -500 Then
                Return String.Empty
            End If
            Return rtnValue
        End Function

        Public Function xCmsArticleTop(ByVal channelid As Integer) As String
            Return xCmsArticleTop(channelid, 10, String.Empty, "default")
        End Function

        Public Function xCmsArticleTop(ByVal channelid As Integer, ByVal rows As Integer) As String
            Return xCmsArticleTop(channelid, rows, String.Empty, "default")
        End Function

        Public Function xCmsArticleTop(ByVal channelid As Integer, ByVal rows As Integer, param As String, ByVal _module As String) As String
            Dim pb As New CMS.Publish(UriKey)
            Dim article As New CMS.cms_top
            article.channelid = channelid
            article.rows = rows
            article.smodule = _module
            article.param = param
            Dim returnValue As String = String.Empty
            returnValue = pb.ConvertCmsTop(article, Me.GetXsltArgList())
            Return returnValue
        End Function


        Public Function xCmsArticleContent(ByVal id As Integer) As String
            Dim pb As New CMS.Publish(UriKey)
            Return pb.xCmsArticleContent(id)
        End Function

        Public Function xCmsArticlePicTop(ByVal channelid As Integer) As String
            Return xCmsArticlePicTop(channelid, 10, String.Empty, "default")
        End Function

        Public Function xCmsArticlePicTop(ByVal channelid As Integer, ByVal rows As Integer) As String
            Return xCmsArticlePicTop(channelid, rows, String.Empty, "default")
        End Function

        Public Function xCmsArticlePicTop(ByVal channelid As Integer, ByVal rows As Integer, param As String, ByVal _module As String) As String
            Dim pb As New CMS.Publish(UriKey)
            Dim article As New CMS.cms_pictop
            article.channelid = channelid
            article.rows = rows
            article.smodule = _module
            article.param = param
            Dim returnValue As String = String.Empty
            returnValue = pb.ConvertCmsPicTop(article, Me.GetXsltArgList())
            Return returnValue
        End Function


        ''' <summary>
        ''' 生成频道栏目
        ''' </summary>s
        ''' <param name="id">栏目</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overridable Function xCmsCreateChannel(ByVal id As String) As String
            Dim rtnValue As String = String.Empty
            Dim pb As New dooll.CMS.Publish(UriKey)
            rtnValue = pb.CreateChannel(id, Server.MapPath(TemplatePath))
            pb = Nothing
            Return (rtnValue)
        End Function

        Public Overridable Function xCmsCreateFile(ByVal path As String, ByVal content As String, ByVal labelconfig As String) As String
            Return CMS.Publish.CreateFile(path, content, labelconfig, Server.MapPath(TemplatePath))
        End Function


        Protected Function CheckParamaters(ByVal params As String, ByVal param As String) As String
            Dim ReplaceValue As String = CStr(IIf(String.IsNullOrEmpty(param), "$1", param))
            params = Regex.Replace(params, "{param:?(?'1'[^}]*)}", ReplaceValue)

            REM 等式右边的值为空时,条件设成真
            For Each m As Match In Regex.Matches(params, "\[\?(?'1'[^\?=]+)(?:=|>|<|<=|>=|<>)(?'2'[^=\[\]]*)]", RegexOptions.IgnoreCase)
                If String.IsNullOrEmpty(m.Groups.Item(2).Value) OrElse String.IsNullOrEmpty(m.Groups.Item(2).Value.Replace("'", String.Empty)) Then
                    params = params.Replace(m.Value, " 1=1 ")
                Else
                    params = params.Replace(m.Value, String.Format("{0}={1}", m.Groups.Item(1).Value, m.Groups.Item(2).Value))
                End If
            Next
            For Each m As Match In Regex.Matches(params, "\[\?(?'1'[^\?=]+)(?:=|>|<|<=|>=|<>)(?'2'[^=\[\]]*)]", RegexOptions.IgnoreCase)
                If String.IsNullOrEmpty(m.Groups.Item(2).Value) OrElse String.IsNullOrEmpty(m.Groups.Item(2).Value.Replace("'", String.Empty)) Then
                    params = params.Replace(m.Value, " 1=1 ")
                Else
                    params = params.Replace(m.Value, String.Format("{0}={1}", m.Groups.Item(1).Value, m.Groups.Item(2).Value))
                End If
            Next
            Return params
        End Function

#End Region


#Region "解析特定的Xml和FileXml"

        Protected Sub LoadInclude(ByRef sb As StringBuilder)
            Dim XsltUri As String = String.Empty, XmlString As String = String.Empty, param As String = String.Empty, mode As String = String.Empty

            For Each m As Match In Regex.Matches(sb.ToString, "<!--\#include(?:\s+)(?<mode>virtual|file)=\""(?'file'[^""]+)\""(?:\s+param=\""(?'param'[^""]+)\"")?\s*-->", RegexOptions.IgnoreCase)

                XsltUri = m.Groups.Item("file").Value
                param = m.Groups.Item("param").Value
                mode = m.Groups.Item("mode").Value
                If LCase(mode) = "file" Then
                    XsltUri = String.Concat(IIf(XsltUri.StartsWith("/"), TemplatePath, LabelPath), XsltUri)
                End If
                sb.Replace(m.Value, xInclude(XsltUri, param))
            Next
        End Sub

        REM 查找CITY:XML标签并替换XML
        Protected Sub LoadInclude(ByRef fnOutHtml As String)
            Dim sb As New StringBuilder(fnOutHtml)
            LoadInclude(sb)
            fnOutHtml = sb.ToString
        End Sub

#End Region

        ''' <summary>
        ''' Debug 写入
        ''' </summary>
        ''' <param name="text"></param>
        ''' <remarks></remarks>
        Public Sub DebugToLog(text As String)
            If LabelInfo.Debug AndAlso AppConfigInfo.Debug AndAlso Not String.IsNullOrEmpty(text) Then
                Util.toLog(String.Concat(Now(), ":", text))
            End If
        End Sub

        Protected Function IsExistsWebCache() As Boolean
            If Not File.Exists(CacheFileFullName) OrElse File.GetLastWriteTime(CacheFileFullName).AddMinutes(LabelInfo.CacheTime) < Now Then
                Return False
            End If
            Return True
        End Function

#Region "其他功能"



        REM 替换非法字符为**
        Public Function StringFilter(ByVal fnOldString As String) As String

            Return fnOldString

            'If String.IsNullOrEmpty(fnOldString) Then Return fnOldString
            'Dim FilterString As String = AppConfigInfo.Filter
            'If Not String.IsNullOrEmpty(FilterString) Then
            'Return Regex.Replace(fnOldString, FilterString, "***", RegexOptions.Compiled Or RegexOptions.IgnoreCase)
            'Else
            'Return fnOldString
            'End If
        End Function

#End Region

        REM 读取Xml文件内容
        Protected Function LoadHtmlTemplate() As StringBuilder
            Dim sb As New StringBuilder
            Dim fnFilePath As String = Server.MapPath(tHtmlFile)
            If Not String.IsNullOrEmpty(fnFilePath) Then
                If IO.File.Exists(fnFilePath) Then
                    Using objStream As New System.IO.StreamReader(fnFilePath, Encoding.GetEncoding(mPageCharSet))
                        sb.Append(objStream.ReadToEnd)
                        objStream.Close()
                        objStream.Dispose()
                    End Using
                Else
                    sb.AppendLine(String.Format("页面不存在 <!--Not Exists[{0}]-->{1}", tHtmlFile, vbCrLf))
                End If
            Else
                sb.AppendLine(String.Format("页面不存在 <!--Not Exists[{0}]-->{1}", tHtmlFile, vbCrLf))
            End If
            Return sb
        End Function

        REM 页面输出
        Public Sub WriteOutHtml()

            REM 文件不存在指向 404 
            If Not IO.File.Exists(Server.MapPath(tHtmlFile)) AndAlso Not Util.AppSettings("debug") = "1" Then
                Response.StatusCode = 404
                Response.End()
            End If
            If Util.AppSettings("Buffer") = "1" Then Response.Buffer = True
            If Not String.IsNullOrEmpty(LabelInfo.CacheControl) Then Response.CacheControl = LabelInfo.CacheControl


            Dim sb As StringBuilder = LoadHtmlTemplate()

            LoadInclude(sb)

            ReplaceRequestString(sb)

            ReplaceLabel(sb)

            REM 替换CMS标签
            ReplaceCmsLabel(sb)

            REM 写页面HTML缓存
            WriteCache(sb.ToString)

            Response.ContentEncoding = System.Text.Encoding.GetEncoding(mPageCharSet)
            Response.Charset = mPageCharSet

            REM 输出页面内容
            Response.Write(sb)
            sb = Nothing

            REM 输出页面运行时间
            If String.IsNullOrEmpty(Request("no-comment")) Then
                Response.Write(String.Format("<!--Run Time - {0}s -->", ((DateTime.Now - PageStartTime).TotalMilliseconds / 1000)))
            End If


            REM 输出页面错误
            If PageConfig.HasError Then Response.Write(Text.Comment(PageConfig.ErrMessage))

            mLabelInfo = Nothing
            mPassport = Nothing
            Response.End()
        End Sub

        Protected Sub WriteCache(ByVal fnOutHtml As String)
            If EnableWebCache AndAlso LabelInfo.EnableCache AndAlso Not ExistsWebCache Then
                Util.SaveString2File(String.Concat(fnOutHtml, "<!--cache on ", Now(), "-->"), CacheFileFullName, False)
            End If
        End Sub

#Region "登录及权限控制功能"


        REM 请求是否来自本站
        Protected Sub IsBasePath()
            Dim Post_Path As String = Request.ServerVariables("http_referer")
            If Not String.IsNullOrEmpty(Post_Path) Then
                Dim uri As New System.UriBuilder(Post_Path)
                If uri.Host <> Request.Url.Host Then
                    Response.Write("500,非法提交数据!!系统不受理!!  ")
                    Response.End()
                End If
            End If
        End Sub

        REM 检验用户权限
        Protected Function ChkPassportRights(ByVal AllowPassportList As String) As Boolean
            If AllowPassportList = "*" Then
                If Passport.IsLogin Then
                    Return True
                End If
            Else
                Return Array.Exists(Split(AllowPassportList, ","), AddressOf allArray)
            End If
            Return False
        End Function

        REM 检查页面权限
        Protected Overridable Sub ChkACL()

            Select Case LabelInfo.ACL

                Case ACL.Passport    '会员身份
                    If Not Passport.IsLogin Then
                        If Request.RawUrl = AppConfigInfo.PassportLoginPage Then
                            Response.Clear()
                            Response.Write("302,页面重定向登录页!")
                            Response.End()
                        End If
                        ShowDenyMessage()
                        Response.End()
                    End If

                Case ACL.ValidCode   '验证码方式
                    If Not ChkVaidCode() Then
                        Response.Write("103,请求验证码未通过!")
                        Response.End()
                    End If
                Case ACL.All '全局权限
                    Return

                Case Else '用于过滤非法权限
                    Response.Clear()
                    Response.Write(String.Concat("403,没有您所定义的权限(", LabelInfo.ACL, ")"))
                    Response.End()

            End Select

        End Sub

        Protected Overridable Sub ChkDefACL()
            Dim result As Boolean
            If Not String.IsNullOrEmpty(LabelInfo.DefACL) Then
                If [Boolean].TryParse(LabelInfo.DefACL, result) Then
                    If Request.RawUrl = AppConfigInfo.PassportLoginPage Then
                        Response.Clear()
                        Response.Write("302,页面重定向登录页!")
                        Response.End()
                    End If
                    ShowDenyMessage()
                    Response.End()
                End If
            End If
        End Sub

        Protected Overridable Sub ShowDenyMessage()
            If String.IsNullOrEmpty(AppConfigInfo.PassportLoginPage) Then
                Response.Write(Util.ReturnValue("403", "你还未登录系统!!!"))
            Else
                If Not IsXmlHttp Then
                    Dim toUrl As String = AbsoluteUri
                    Response.Redirect(String.Concat(AppConfigInfo.PassportLoginPage, "?toUrl=", Server.UrlEncode(toUrl)))
                Else
                    Response.Write(Util.ReturnValue("403", "你还未登录系统!!!"))
                End If
            End If
        End Sub

        Protected Function allArray(ByVal fnString As String) As Boolean
            If fnString = CStr(Passport.UserID) Then
                Return True
            Else
                Return False
            End If
        End Function

        REM 检验SessionID 是否为本机
        Protected Function ChkSessionId(ByVal requestSessionId As String) As Boolean
            If requestSessionId Is Nothing Then
                Response.Write("802,请提交您的身份标识,否则系统不受理......")
                Response.End()
            Else
                If Not requestSessionId = Session.SessionID Then
                    Response.Write("804,您提交的是过时的数据,系统不受理......")
                    Response.End()
                End If
            End If
        End Function

        REM 检测Request.Form提交的验证码是否一致
        Protected Function ChkVaidCode() As Boolean

            '全局是否要求检查验证码
            If Not AppConfigInfo.AdminCheckVaidCode Then
                Return True
            End If

            Dim vCodeCookie As HttpCookie = Request.Cookies("CheckCode")
            Dim vCode As String = Request("vCode")

            If Not String.IsNullOrEmpty(vCode) AndAlso (Not vCodeCookie Is Nothing) AndAlso vCodeCookie.Value = vCode Then
                Request.Cookies.Remove("CheckCode")
                Return True
            Else
                Return False
            End If
        End Function
#End Region

        Protected Overridable Sub ReplacePostString(ByRef sb As StringBuilder)
            ReplaceRequestString(sb)
            Dim fnMatchs As MatchCollection
            REM 替换{form:YYY}的表达式
            fnMatchs = Regex.Matches(sb.ToString, "{form:(?'1'\w+):?(?'2'[^{}]*)}", RegexOptions.IgnoreCase Or RegexOptions.Compiled)
            For Each m As Match In fnMatchs
                Try
                    If String.IsNullOrEmpty(m.Groups.Item(1).Value) Then
                        sb.Replace(m.Value, String.Empty)
                        Continue For
                    ElseIf String.IsNullOrEmpty(Request.Form(m.Groups.Item(1).Value)) Then
                        sb.Replace(m.Value, m.Groups.Item(2).Value)
                        Continue For
                    Else
                        sb.Replace(m.Value, Text.XmlFilter(Request.Form(m.Groups.Item(1).Value)))
                    End If

                Catch ex As Exception
                    Response.Write("101," & ex.Message)
                End Try
            Next
            fnMatchs = Nothing
        End Sub

        Protected Sub SavePostContent(ByVal fnKey As String)
            If LabelInfo.Tables Is Nothing OrElse LabelInfo.Tables.Length = 0 Then
                Response.Clear()
                Response.Write(Util.ReturnValue("404", String.Concat("找不到表[", fnKey, "].")))
                Response.End()
            End If
            Dim fTableItem As TableItem = LabelInfo.FindTable(fnKey)
            If fTableItem Is Nothing Then
                Response.Clear()
                Response.Write(Util.ReturnValue("404", String.Concat("找不到表[", fnKey, "].")))
                Response.End()
            End If
            If String.IsNullOrEmpty(fTableItem.Xml) OrElse Not IO.File.Exists(Server.MapPath(fTableItem.Xml)) Then
                Response.Clear()
                Response.Write(Util.ReturnValue("404", String.Concat("表[", fnKey, "]配置文件不存在!!")))
                Response.End()
            End If

            Dim ErrMessage As String = Util.ReturnValue("500", "未知错误")
            If Not fTableItem.ACL Is Nothing AndAlso Not ChkLabelItemACL(fTableItem.ACL, fnKey, ErrMessage, Request.Form) Then
                Response.Clear()
                Response.Write(ErrMessage)
                Response.End()
            End If

            Dim ReturnCode As Integer = 500
            Dim ReturnMessage As String = "未知错误"
            Try
                Dim NewTable As New XmlTable(UriKey)
                NewTable.Load(Server.MapPath(fTableItem.Xml))
                Dim Sb As New StringBuilder(NewTable.OuterXml)
                ReplacePostString(Sb)
                NewTable.LoadXml(Sb.ToString)

                ReturnCode = NewTable.Update()
                ReturnMessage = NewTable.ErrMessage
                NewTable = Nothing
            Catch ex As Exception
                ReturnMessage = ex.Message
            End Try

            Select Case ReturnCode
                Case 1
                    ReturnMessage = "记录新增成功."
                Case 2
                    ReturnMessage = "记录更新成功."
            End Select

            Response.Clear()
            Response.Write(Util.ReturnValue(CStr(ReturnCode), ReturnMessage))
            Response.End()
        End Sub

        Protected Function SendSmtpMail(ByVal Email As String, ByVal fnKey As String) As Integer

        End Function


#Region "页面事件"

        Private Sub Page_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
            mLabelInfo = Nothing
            mPassport = Nothing
            'mDataBase.Dispose()
            mDataBase = Nothing
        End Sub

        Private Sub Page_Init(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Init
            'AppConfig.load()
            mPageCharSet = xConfig("charset", "utf-8")
            Rules = ReWriteConfig.Load()
            '加载主站令牌
            Dim tokenValue As String = Request.QueryString("Token")
            If Not String.IsNullOrEmpty(tokenValue) Then
                If LCase(tokenValue) = "$token$" Then
                    redirectTokenUrl()
                Else
                    LoadToken(tokenValue)
                End If
            End If
        End Sub

        Private Sub Page_InitComplete(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.InitComplete
            Page.EnableViewState = False

            mLabelInfo = PageConfig.Load(LabelConfigFile)

            If Not String.IsNullOrEmpty(mLabelInfo.CharSet) Then
                mPageCharSet = mLabelInfo.CharSet
            End If

            Request.ContentEncoding = Encoding.GetEncoding(mPageCharSet)

            ChkACL()

            If Request.QueryString("mustupdate") = "now" Then
                If IO.File.Exists(CacheFileFullName) Then
                    Try
                        SyncLock mHelper
                            IO.File.Delete(CacheFileFullName)
                        End SyncLock
                    Catch ex As Exception
                        Response.Write(CacheFileFullName)
                        Response.Write("<br/>")
                        Response.Write(ex.Message)
                        Response.End()
                    End Try
                End If
            End If
            REM --------------检查模板文件和缓存是否存在----------------
            If EnableWebCache And mLabelInfo.EnableCache Then
                ExistsWebCache = IsExistsWebCache()
                If ExistsWebCache Then
                    If Not String.IsNullOrEmpty(LabelInfo.CacheControl) Then Response.CacheControl = LabelInfo.CacheControl
                    Response.TransmitFile(CacheFileFullName)
                    Response.End()
                End If
            End If


            If Not String.IsNullOrEmpty(LabelInfo.Compression) Then
                If LabelInfo.Compression.ToLower() = "true" Then CallCompression()
            ElseIf Not String.IsNullOrEmpty(AppConfigInfo.Compression) Then
                If AppConfigInfo.Compression.ToLower = "true" Then CallCompression()
            End If
        End Sub




        ''' <summary>
        ''' 生成存储过程数组
        ''' </summary>
        ''' <param name="params">ParamItem()</param>
        ''' <returns>System.Data.Common.DbParameter</returns>
        ''' <remarks></remarks>
        Protected Function GetStroeProcParam(ByVal params As ParamItem(), ByVal sParam As String, Optional ByRef checkparam As String = "true", Optional ByRef s As String = "") As System.Data.Common.DbParameter()
            checkparam = "true"
            If params Is Nothing OrElse params.Length = 0 Then
                Return Nothing
            End If
            Dim RtnValue(params.Length) As System.Data.Common.DbParameter
            Dim it As ParamItem
            Dim val As String = String.Empty
            Dim m As String
            For i As Integer = 0 To params.Length - 1
                it = params(i)
                val = ReplaceRequestString(it.Value)
                val = val.Replace("{param}", sParam)
                If Not String.IsNullOrEmpty(it.regex) Then
                    m = "字段[{0}]不符合填写的要求"
                    If Not String.IsNullOrEmpty(it.message) Then
                        m = it.message
                    End If

                    If Not Regex.IsMatch(val, it.regex, RegexOptions.IgnoreCase) Then
                        checkparam = String.Format("{0},{1},{2}", 101, String.Format(m, it.field), it.field)
                        Return Nothing
                    End If
                End If
                RtnValue(i) = DataBase.CreateParameter()
                RtnValue(i).ParameterName = it.field
                RtnValue(i).Value = val
                s = String.Concat(s, it.field, "=", val, ";")
            Next
            DebugToLog(String.Concat("proc param -", s))
            Return RtnValue
        End Function

        Protected Function GetTableWhere(ByVal wi As WhereItem(), ByVal fnParam As String) As String

            Dim s As String = String.Empty
            If Not wi Is Nothing Then

                For Each item As WhereItem In wi

                    If item.mode.ToLower = "between" Then
                        Dim MinValue As String = Replace(ReplaceRequestString(item.MinValue), "'", "''")
                        Dim MaxValue As String = Replace(ReplaceRequestString(item.MaxValue), "'", "''")
                        s = String.Concat(s, " ", item.andor, " ", item.field, " ", item.mode, " ", MinValue, " and ", MaxValue)
                    Else

                        Dim itemValue As String = ReplaceRequestString(item.Value)
                        itemValue = itemValue.Replace("{param}", fnParam)

                        If Not String.IsNullOrEmpty(itemValue) Then



                            '检查值是否符合正则表达式
                            If Not String.IsNullOrEmpty(item.regex) And Not Regex.IsMatch(itemValue, item.regex) Then
                                Continue For
                            End If


                            itemValue = Replace(itemValue, "'", "''")

                            If item.mode.ToLower = "like" Then
                                itemValue = String.Format(item.pattern, itemValue)
                            End If

                            s = String.Concat(s, " ", item.andor, IIf(item.before = 1, " (", " "), item.field, " ", item.mode, String.Format(item.format, itemValue), IIf(item.after = 1, ")", ""))

                        End If
                    End If

                Next
            End If

            If Not String.IsNullOrEmpty(s) Then s = String.Concat("1=1 ", s)
            Return s

        End Function



        Private Sub Page_LoadComplete(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LoadComplete
            mHelper = Nothing
            If Not mDataBase Is Nothing Then
                'mDataBase.Dispose()
                mDataBase = Nothing
            End If
            mLabelInfo = Nothing
            mPassport = Nothing
            mNavigator = Nothing
        End Sub

#End Region

#Region "XSLT扩展功能"

        REM ******************************************
        REM ***********以下为XSLT扩展功能*************
        REM ******************************************


        ''' <summary>
        ''' 检查页面安全
        ''' </summary>
        ''' <returns>返回true/错误信息</returns>
        ''' <remarks>返回true/错误信息</remarks>
        Public Function xSecurity(ByVal sParam As String) As String
            If LabelInfo.Security Is Nothing OrElse LabelInfo.Security.Length = 0 Then
                Return "true"
            Else
                For Each it As ParamItem In LabelInfo.Security
                    Dim val As String = ReplaceRequestString(it.Value)
                    val.Replace("{param}", sParam)
                    If Not String.IsNullOrEmpty(it.regex) Then
                        Dim m As String = "无权访问此页面[{0}]"
                        If Not String.IsNullOrEmpty(it.message) Then
                            m = it.message
                        End If

                        If Regex.IsMatch(val, it.regex, RegexOptions.IgnoreCase) Then
                            Return "true"
                        Else
                            Return (String.Format(m, it.name))
                        End If
                    End If
                Next
                Return "true"
            End If
        End Function


        ''' <summary>
        ''' 加载模块
        ''' </summary>
        ''' <param name="s">模块名</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xLoadList(ByVal s As String) As String
            Return LoadList(s)
        End Function

        Public Function xLoadList(ByVal s As String, ByVal p As String) As String
            Return LoadList(s, 0, p)
        End Function

        Public Function xLoadList(ByVal s As String, ByVal c As Integer, ByVal p As String) As String
            Return LoadList(s, c, p)
        End Function

        Public Function xLoadList(ByVal s As String, ByVal c As Integer, ByVal p As String, xslt As String) As String
            Return LoadList(s, c, p, xslt)
        End Function

        ''' <summary>
        ''' 替换CMS 标签
        ''' </summary>
        ''' <param name="s"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xReplaceCmsLabel(s As String) As String
            Return ReplaceCmsLabel(New StringBuilder(s))
        End Function

        ''' <summary>
        ''' 替换所有标签
        ''' </summary>
        ''' <param name="s"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xReplaceLabel(s As String) As String
            Dim sb As New StringBuilder(s)
            LoadInclude(sb)
            ReplaceRequestString(sb)
            ReplaceLabel(sb)
            ReplaceCmsLabel(sb)
            Return sb.ToString
        End Function

        ''' <summary>
        ''' 页面文件名(不含扩展名)
        ''' </summary>
        ''' <returns>页面文件名</returns>
        ''' <remarks></remarks>
        Public Function xAction() As String
            Return IO.Path.GetFileNameWithoutExtension(tHtmlFile)
        End Function


        ''' <summary>
        ''' 获取系统当前日期和时间
        ''' </summary>
        ''' <returns>当前日期和时间</returns>
        ''' <remarks></remarks>
        Public Function xNow() As String
            Return DateTime.Now.ToString()
        End Function

        ''' <summary>
        ''' 获取指定格式系统当前日期和时间
        ''' </summary>
        ''' <param name="s">指定格式</param>
        ''' <returns>当前日期和时间</returns>
        ''' <remarks></remarks>
        Public Function xNow(ByVal s As String) As String
            Return DateTime.Now.ToString(s)
        End Function

        ''' <summary>
        ''' 获取url get请求
        ''' </summary>
        ''' <param name="s">get请求关键字</param>
        ''' <returns>返回get的值</returns>
        ''' <remarks></remarks>
        Public Function xRequest(ByVal s As String) As String
            Return xRequest(s, String.Empty)
        End Function

        ''' <summary>
        ''' 指定的字符串v是否字符数组串s中存在
        ''' </summary>
        ''' <param name="s">字符数组串</param>
        ''' <param name="c">分隔符</param>
        ''' <param name="v">指定的字符串</param>
        ''' <returns>boolean</returns>
        ''' <remarks></remarks>
        Public Function xIn(s As String, c As String, v As String) As Boolean
            Dim a As String() = s.Split(CChar(c))
            If Array.IndexOf(a, v) = -1 Then
                Return False
            Else
                Return True
            End If
        End Function

        ''' <summary>
        ''' 获取url get请求,带默认值
        ''' </summary>
        ''' <param name="s">get请求关键字</param>
        ''' <param name="d">默认值</param>
        ''' <returns>返回get的值</returns>
        ''' <remarks></remarks>
        Public Function xRequest(ByVal s As String, ByVal d As String) As String

            Dim RtnValue As String = Request.QueryString(s)

            '2012-06-08 加get关键字过滤
            DoKWFilter(1, RtnValue)

            If String.IsNullOrEmpty(RtnValue) Then
                RtnValue = d
            Else
                REM 过滤'|'字符防止数据分组错误
                If Not String.IsNullOrEmpty(RtnValue) Then RtnValue = RtnValue.Replace("|", "~~~")

                REM 增加数据库过滤
                RtnValue = Text.SqlFilter(RtnValue, AppConfigInfo.SqlLabel)
            End If
            Return RtnValue
        End Function

        ''' <summary>
        ''' 返回 页面post提交的值,带默认值
        ''' </summary>
        ''' <param name="s">post关键字</param>
        ''' <returns>post的值</returns>
        ''' <remarks></remarks>
        Public Function xForm(ByVal s As String) As String
            Return xForm(s, String.Empty)
        End Function

        ''' <summary>
        ''' 返回 页面post提交的值
        ''' </summary>
        ''' <param name="s">post关键字</param>
        ''' <param name="d">默认值</param>
        ''' <returns>post的值</returns>
        ''' <remarks></remarks>
        Public Function xForm(ByVal s As String, ByVal d As String) As String
            Dim RtnValue As String = Request.Form(s)

            '2012-06-08 加post关键字过滤
            DoKWFilter(2, RtnValue)

            If String.IsNullOrEmpty(RtnValue) Then
                Return d
            End If

            Return RtnValue
        End Function

        Public Function xCmsModuleSaveCache(name As String, content As String) As String
            Dim path As String = CMS.Publish.GetModuleCachePath(name)
            Return xCreateFile(path, content)
        End Function

        Public Function xCreateFile(path As String, content As String) As String
            Dim rtnvalue As String = CMS.Publish.CreateFile(Server.MapPath(path), content)
            If String.IsNullOrEmpty(rtnvalue) Then
                Return "true"
            Else
                Return rtnvalue
            End If
        End Function

        ''' <summary>
        ''' 转换编码
        ''' </summary>
        ''' <param name="content"></param>
        ''' <param name="sourceCode"></param>
        ''' <param name="targetCode"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xConvertCode(content As String, sourceCode As String, targetCode As String) As String

            Dim source As Encoding = Encoding.GetEncoding(sourceCode)
            Dim target As Encoding = Encoding.GetEncoding(targetCode)
            Dim bSource As Byte() = source.GetBytes(content)
            Dim bTarget As Byte() = Encoding.Convert(source, target, bSource)
            Return target.GetString(bTarget)
        End Function

        ''' <summary>
        ''' 上传文件对象
        ''' </summary>
        ''' <param name="s">文件控件</param>
        ''' <returns>上传的结果 代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xFile(ByVal s As String) As String
            Return xFile(s, -1, String.Empty, AppConfigInfo.Watermarktype)
        End Function

        ''' <summary>
        ''' 上传文件对象
        ''' </summary>
        ''' <param name="s">文件控件</param>
        ''' <param name="d">默认值</param>
        ''' <returns>上传的结果 代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xFile(ByVal s As String, ByVal d As Integer) As String
            Return xFile(s, d, String.Empty, AppConfigInfo.Watermarktype)
        End Function

        ''' <summary>
        ''' 翻转图片
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xRotateBitmap() As String
            Dim rtnValue As String
            Dim src As String = Request.QueryString("src")
            Dim angle = Single.Parse(Request.QueryString("angle"))
            Dim upload As New Uploader
            rtnValue = upload.RotateBitmap(src, angle)
            upload = Nothing
            Return rtnValue
        End Function

        ''' <summary>
        ''' 图片裁剪
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xCuteBitmap() As String
            Dim rtnValue As String

            If String.IsNullOrEmpty(UploadCtrl.UploadPath) Then
                UploadCtrl.UploadPath = AppConfigInfo.UploadPath
            End If
            If String.IsNullOrEmpty(UploadCtrl.ThumbnailPath) Then
                UploadCtrl.ThumbnailPath = AppConfigInfo.ThumbnailPath
            End If
            Try
                Dim upload As New Uploader
                Dim src As String = Request.QueryString("src")

                rtnValue = upload.CuteBitmap(src, UploadCtrl, CDbl(Request("zoom")), -CInt(Request("x")), -CInt(Request("y")), CInt(Request("width")), CInt(Context.Request("height")))

                If String.IsNullOrEmpty(rtnValue) Then
                    rtnValue = "{""msg"":""rtnValue=nothing," + upload.ErrMessage + """}"
                End If
                upload = Nothing
                Return rtnValue
            Catch ex As Exception
                Return "{""msg"":""xCuteBitmap:" + ex.Message + """}"
            End Try

        End Function

        ''' <summary>
        ''' 保存文件
        ''' </summary>
        ''' <param name="s">文件控件名称</param>
        ''' <param name="d">默认值 0 全局 </param>
        ''' <param name="watertext"></param>
        ''' <param name="watermarkType"></param>
        ''' <returns>上传的结果 代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xFile(ByVal s As String, ByVal d As Integer, ByVal watertext As String, ByVal watermarkType As Integer) As String
            Dim rtnValue As String

            If String.IsNullOrEmpty(UploadCtrl.UploadPath) Then
                UploadCtrl.UploadPath = AppConfigInfo.UploadPath
            End If
            If String.IsNullOrEmpty(UploadCtrl.ThumbnailPath) Then
                UploadCtrl.ThumbnailPath = AppConfigInfo.ThumbnailPath
            End If


            Dim thumbnailpath As String = Request.Form("thumbnailpath")
            If Not String.IsNullOrEmpty(thumbnailpath) Then
                UploadCtrl.ThumbnailPath = thumbnailpath
            End If

            Dim uploadpath As String = Request.Form("uploadpath")
            If Not String.IsNullOrEmpty(uploadpath) Then
                UploadCtrl.UploadPath = uploadpath
            End If

            Dim thumbnail As String = Request.Form("thumbnail")
            If Not String.IsNullOrEmpty(thumbnail) Then
                If thumbnail = "0" Then
                    UploadCtrl.ThumbnailMode = 0
                Else
                    Dim thum As String() = Split(thumbnail, ",")

                    If thum.Length = 3 Then
                        mUploadCtrl.ThumbnailMode = CInt(thum(0))
                        mUploadCtrl.ThumbnailWidth = CInt(thum(1))
                        mUploadCtrl.ThumbnailHeight = CInt(thum(2))
                    End If
                End If
            End If

            Dim canvas As String = Request.Form("canvas")
            If Not String.IsNullOrEmpty(canvas) Then
                UploadCtrl.Canvas = canvas
            End If

            UploadCtrl.WaterMarkText = watertext
            UploadCtrl.WaterMarkType = CInt(IIf(String.IsNullOrEmpty(watertext), watermarkType, 1))


            Try

                Dim PostedFile As HttpPostedFile = Request.Files(s)
                Dim upl As New Uploader
                If PostedFile Is Nothing OrElse PostedFile.ContentLength <= 0 Then
                    PostedFile = Nothing
                    rtnValue = String.Format("404,,,{0}", "请确保您上传的文件是正确的！！")
                Else
                    Try
                        rtnValue = upl.SavePostedFile(PostedFile, UploadCtrl)

                        If String.IsNullOrEmpty(rtnValue) Then
                            rtnValue = String.Format("500,,,{0}", Replace(upl.ErrMessage, ",", "，"))
                        Else
                            rtnValue = String.Format("0,{0},{1},{2}", String.Concat(UploadCtrl.UploadPath, rtnValue), String.Concat(UploadCtrl.ThumbnailPath, rtnValue), "文件上传成功!")
                        End If

                    Catch ex As Exception
                        rtnValue = String.Format("500,,,{0}", Replace(ex.Message, ",", "，"))
                    End Try

                End If

                If d > -1 Then
                    rtnValue = rtnValue.Split(CChar(","))(d)
                End If

                PostedFile = Nothing
                upl = Nothing
            Catch ex As Exception
                DebugToLog(ex.Message)
                rtnValue = String.Format("500,,,{0}", Replace(ex.Message, ",", "，"))
            End Try
            Return rtnValue
        End Function

        ''' <summary>
        ''' 上传文件操作
        ''' </summary>
        ''' <param name="s">file名称</param>
        ''' <returns>上传结果js脚本:代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xUpload(ByVal s As String) As String
            Return xUpload(s, String.Empty, AppConfigInfo.Watermarktype)
        End Function


        ''' <summary>
        ''' 上传文件操作
        ''' </summary>
        ''' <param name="s">file名称</param>
        ''' <param name="pWatermarkType">水印类型</param>
        ''' <returns>上传结果js脚本:代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xUpload(ByVal s As String, ByVal pWatermarkType As Integer) As String
            Return xUpload(s, String.Empty, pWatermarkType)
        End Function

        ''' <summary>
        ''' 上传文件操作
        ''' </summary>
        ''' <param name="s">提交post的文件名</param>
        ''' <param name="watertext">水印文字</param>
        ''' <returns>上传结果js脚本:代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xUpload(ByVal s As String, ByVal watertext As String, ByVal pWatermarkType As Integer) As String
            Dim str As String = xFile(s, -1, watertext, pWatermarkType)
            Dim rtnValue As String() = str.Split(CChar(","))

            If rtnValue.Length < 4 Then
                Return Util.OnUploadCompleted(CInt(rtnValue(0)), str, "", rtnValue(1))
            End If

            Return Util.OnUploadCompleted(CInt(rtnValue(0)), rtnValue(1), rtnValue(2), rtnValue(3))

        End Function


        ''' <summary>
        ''' 远程文件上传
        ''' </summary>
        ''' <param name="RemoteUrl">远程url</param>
        ''' <param name="watertext">水印文字</param>
        ''' <returns>上传结果js脚本:代码,文件,缩略图,错误信息</returns>
        ''' <remarks></remarks>
        Public Function xUploadRemoteToLocal(ByVal RemoteUrl As String, ByVal watertext As String) As String
            Dim VFileUrl As String = String.Empty
            Dim upl As New Uploader
            Try
                If Not String.IsNullOrEmpty(watertext) Then
                    UploadCtrl.WaterMarkType = 1
                    UploadCtrl.WaterMarkText = watertext
                End If
                VFileUrl = upl.SaveRemoteUpload(RemoteUrl, UploadCtrl)
            Catch ex As Exception
                Return Util.OnUploadCompleted(100, "", "", ex.Message)
            End Try

            If String.IsNullOrEmpty(VFileUrl) Then
                Return Util.OnUploadCompleted(101, "", "", "上传失败,原因:\n" + upl.ErrMessage)
            Else
                Return Util.OnUploadCompleted(0, String.Concat(AppConfigInfo.UploadPath, VFileUrl), String.Concat(AppConfigInfo.ThumbnailPath, VFileUrl), "文件上传成功!!!!")
            End If
            upl = Nothing
        End Function


        ''' <summary>
        ''' 取ServerVariables值
        ''' </summary>
        ''' <param name="s">关键字</param>
        ''' <returns>ServerVariables值</returns>
        ''' <remarks></remarks>
        Public Function xServer(ByVal s As String) As String
            Return xServer(s, String.Empty)
        End Function

        ''' <summary>
        ''' 取ServerVariables值
        ''' </summary>
        ''' <param name="s">关键字</param>
        ''' <param name="d">默认值</param>
        ''' <returns>ServerVariables值</returns>
        ''' <remarks></remarks>
        Public Function xServer(ByVal s As String, ByVal d As String) As String
            Dim RtnValue As String = Request.ServerVariables(s)
            If String.IsNullOrEmpty(RtnValue) Then
                Return d
            End If
            Return RtnValue
        End Function

        ''' <summary>
        ''' 取登录字段值
        ''' </summary>
        ''' <param name="s">字段名</param>
        ''' <returns>字段值</returns>
        ''' <remarks></remarks>
        Public Function xLogin(ByVal s As String) As String
            Return xLogin(s, String.Empty)
        End Function

        ''' <summary>
        ''' 取登录字段值
        ''' </summary>
        ''' <param name="s">字段名</param>
        ''' <param name="d">默认值</param>
        ''' <returns>字段值</returns>
        ''' <remarks></remarks>
        Public Function xLogin(ByVal s As String, ByVal d As String) As String
            If Not Passport.IsLogin Then
                Return String.Empty
            End If
            Dim RtnValue As String = Passport.Item(s)

            If String.IsNullOrEmpty(RtnValue) Then
                Return d
            Else
                Return RtnValue
            End If

        End Function

        ''' <summary>
        ''' 加载CMS数据库模块
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xLoadCmsModule(ByVal name As String) As String
            Dim returnValue As String = String.Empty
            Dim pb As New CMS.Publish(UriKey)
            returnValue = pb.loadCmsModule(name)
            Return returnValue
        End Function

        ''' <summary>
        ''' xslt文件包含
        ''' </summary>
        ''' <param name="f">文件名</param>
        ''' <returns>包含文件</returns>
        ''' <remarks></remarks>
        Public Function xInclude(ByVal f As String) As String
            Return xInclude(f, String.Empty)
        End Function

        ''' <summary>
        ''' xslt文件包含
        ''' </summary>
        ''' <param name="f">文件名</param>
        ''' <param name="param">附加参数值</param>
        ''' <returns>包含文件</returns>
        ''' <remarks></remarks>
        Public Function xInclude(ByVal f As String, ByVal param As String) As String
            f = Server.MapPath(f)

            If Not IO.File.Exists(f) Then
                Return String.Format("{0}文件不存在", f)
            End If
            Dim RtnValue As String
            If f.EndsWith(".xsl") Then
                Dim XsltArgList As System.Xml.Xsl.XsltArgumentList = GetXsltArgList()
                XsltArgList.AddParam("param", String.Empty, param)
                RtnValue = XsltCompiled.XmlTrans(New System.Xml.XPath.XPathDocument(New StringReader("<rows/>")), XsltArgList, f)
                XsltArgList = Nothing
            Else
                Dim html As String = IO.File.ReadAllText(f, Encoding.GetEncoding(mPageCharSet))
                RtnValue = ReplaceRequestString(html.Replace("{param}", param))

            End If

            Return RtnValue
        End Function

        ''' <summary>
        ''' 条件判断
        ''' </summary>
        ''' <param name="b">条件表达式</param>
        ''' <param name="ts">结果真</param>
        ''' <param name="fs">结果假</param>
        ''' <returns>条件判断结果</returns>
        ''' <remarks></remarks>
        Public Function xIIF(ByVal b As Boolean, ByVal ts As String, ByVal fs As String) As String
            Return CStr(IIf(b, ts, fs))
        End Function

        ''' <summary>
        ''' 数字选项菜单
        ''' </summary>
        ''' <param name="s">起始数字</param>
        ''' <param name="e">结束数字</param>
        ''' <param name="d">默认值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xNumOptions(ByVal s As Integer, ByVal e As Integer, ByVal d As String) As String
            Return xNumOptions("{0}", s, e, d)
        End Function

        ''' <summary>
        ''' 数字选项菜单
        ''' </summary>
        ''' <param name="f">格式,可使用{0}值显示的内容</param>
        ''' <param name="s">起始数字</param>
        ''' <param name="e">结束数字</param>
        ''' <param name="d">默认值</param>
        ''' <returns></returns>
        ''' <remarks> option value="{0}" {1} 第{0}月 option </remarks>
        Public Function xNumOptions(ByVal f As String, ByVal s As Integer, ByVal e As Integer, ByVal d As String) As String
            Return xNumOptions(String.Concat("<option value=""{0}"" {1}>", f, "</option>"), s, e, d, " selected=""true"" ")
        End Function

        ''' <summary>
        ''' 数字选项有单
        ''' </summary>
        ''' <param name="f"></param>
        ''' <param name="s"></param>
        ''' <param name="e"></param>
        ''' <param name="d"></param>
        ''' <param name="ds"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xNumOptions(ByVal f As String, ByVal s As Integer, ByVal e As Integer, ByVal d As String, ByVal ds As String) As String
            Dim RtnValue As String = String.Empty
            Dim dd As Integer
            If String.IsNullOrEmpty(Trim(d)) Then
                dd = 0
            Else
                dd = CInt(d)
            End If
            For i As Integer = s To e
                RtnValue += String.Format(f, i, IIf(i = dd, ds, String.Empty))
            Next
            Return RtnValue
        End Function


        ''' <summary>
        ''' URL编码
        ''' </summary>
        ''' <param name="f">文件名</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xEncodeURI(ByVal f As String) As String
            Return System.Uri.EscapeUriString(f)
        End Function

        ''' <summary>
        ''' URL编码
        ''' </summary>
        ''' <param name="f">文件名</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xEncodeURIComponent(ByVal f As String) As String
            Return System.Uri.EscapeDataString(f)
        End Function

        ''' <summary>
        ''' 正则替换
        ''' </summary>
        ''' <param name="f">需要替换字符串</param>
        ''' <param name="p">正则表达式</param>
        ''' <param name="r">替换</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xReplace(ByVal f As String, ByVal p As String, ByVal r As String) As String
            Return Regex.Replace(f, p, r, RegexOptions.IgnoreCase)
        End Function

        ''' <summary>
        ''' 左取字符
        ''' </summary>
        ''' <param name="str"></param>
        ''' <param name="length"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xLeft(str As String, length As Integer) As String
            Return xSubString(str, 0, length)
        End Function

        ''' <summary>
        ''' 截取字段
        ''' </summary>
        ''' <param name="str"></param>
        ''' <param name="start"></param>
        ''' <param name="length"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xSubString(str As String, start As Integer, length As Integer) As String
            Dim temp As String = str
            Dim j As Integer = 0
            Dim k As Integer = 0
            For i As Integer = 0 To str.Length - 1
                If Regex.IsMatch(temp.Substring(i, 1), "[\u4e00-\u9fa5]+") Then
                    j += 2
                Else
                    j += 1
                End If
                If j <= length Then
                    k += 1
                End If
                If j >= length Then
                    Return temp.Substring(start, k)
                End If
            Next
            Return temp
        End Function


        ''' <summary>
        ''' 字符格式
        ''' </summary>
        ''' <param name="s">格式字符串</param>
        ''' <param name="a">以，分隔的字符串</param>
        ''' <param name="c">分隔符</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xFormat(ByVal s As String, ByVal a As String, ByVal c As String) As String
            Return String.Format(s, a.Split(CChar(c)))
        End Function

        ''' <summary>
        ''' 字符串格化
        ''' </summary>
        ''' <param name="s">格式字符串</param>
        ''' <param name="a">字符串分隔符(,)数组</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xFormat(ByVal s As String, ByVal a As String) As String
            Return String.Format(s, a.Split(CChar(",")))
        End Function

        ''' <summary>
        ''' 格式化时间
        ''' </summary>
        ''' <param name="s">字符串格式的时间</param>
        ''' <param name="f">指定的格式</param>
        ''' <returns>返回指定式的时间</returns>
        ''' <remarks>如果转换失败就返回原时间</remarks>
        Public Function xDateFormat(ByVal s As String, f As String) As String
            Dim dt As New DateTime
            If DateTime.TryParse(s, dt) Then
                Return dt.ToString(f)
            Else
                Return s
            End If
        End Function

        ''' <summary>
        ''' 增加时间
        ''' </summary>
        ''' <param name="dts">时间</param>
        ''' <param name="day">新增的天数</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xAddDay(dts As String, day As Integer) As String
            Dim dt As Date = Convert.ToDateTime(dts)
            Return dt.AddDays(day).ToString("yyyy-MM-dd")
        End Function

        ''' <summary>
        ''' 月初
        ''' </summary>
        ''' <param name="dts"></param>
        ''' <param name="months"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xMonthBegin(dts As String, months As Integer) As String
            Dim dt As Date = Convert.ToDateTime(dts)
            dt = dt.AddMonths(months)
            Dim newdt As Date = New System.DateTime(dt.Year, dt.Month, 1)
            Return newdt.ToString("yyyy-MM-dd")
        End Function

        ''' <summary>
        ''' 月初
        ''' </summary>
        ''' <param name="dts"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xMonthBegin(dts As String) As String
            Return xMonthBegin(dts, 0)
        End Function

        ''' <summary>
        ''' 月底
        ''' </summary>
        ''' <param name="dts"></param>
        ''' <param name="months"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xMonthEnd(dts As String, months As Integer) As String
            Dim dt As Date = Convert.ToDateTime(dts)
            dt = dt.AddMonths(months)
            Dim newdt As Date = New System.DateTime(dt.Year, dt.Month, 1)
            Return newdt.AddMonths(1).AddDays(-1).ToString("yyyy-MM-dd")
        End Function

        ''' <summary>
        ''' 月底
        ''' </summary>
        ''' <param name="dts"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xMonthEnd(dts As String) As String
            Return xMonthEnd(dts, 0)
        End Function

        ''' <summary>
        ''' 是否匹配
        ''' </summary>
        ''' <param name="f">输入字符串</param>
        ''' <param name="p">正则表达式</param>
        ''' <returns>是否匹配</returns>
        ''' <remarks></remarks>
        Public Function xMatch(ByVal f As String, ByVal p As String) As Boolean
            Return Regex.IsMatch(f, p, RegexOptions.IgnoreCase)
        End Function

        ''' <summary>
        ''' xslt 分拆函数
        ''' </summary>
        ''' <param name="f">字符串</param>
        ''' <param name="c">分隔符</param>
        ''' <param name="ns">索引值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xSplit(ByVal f As String, ByVal c As String, ByVal ns As String) As String
            Dim n As Integer = 0
            If Not String.IsNullOrEmpty(ns) AndAlso IsNumeric(ns) Then
                n = CInt(ns)
            Else
                n = 0
            End If

            Dim a As String() = f.Split(CChar(c))
            If n >= a.Length Then
                Return String.Empty
            End If
            If String.IsNullOrEmpty(a(n)) Then
                Return String.Empty
            End If
            Return a(n)
        End Function

        ''' <summary>
        ''' 正则分拆
        ''' </summary>
        ''' <param name="f">原字符串</param>
        ''' <param name="c">分隔字符串</param>
        ''' <param name="index">返回索引,0开始</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xRegexSplit(ByVal f As String, ByVal c As String, ByVal index As Integer) As String
            Dim rtn As String()
            Try
                rtn = Regex.Split(f, c, RegexOptions.IgnoreCase)
                If index < rtn.Length Then
                    Return rtn(index)
                End If
            Catch ex As Exception
                Return String.Empty
            End Try
            Return String.Empty
        End Function

        ''' <summary>
        ''' 用户的cookie存的Session 值,替代SessionID
        ''' </summary>
        ''' <returns>SessionID值</returns>
        ''' <remarks></remarks>
        Public Function xSessionID() As String
            Dim SessionIdName As String = "dooll_SessionId"
            If Request.Cookies(SessionIdName) Is Nothing Then
                Dim c As HttpCookie = New HttpCookie(SessionIdName, Session.SessionID)
                Response.Cookies.Add(c)
            End If
            Return Request.Cookies(SessionIdName).Value
        End Function

        ''' <summary>
        ''' Cookie值(utf8格式)
        ''' </summary>
        ''' <param name="k">key</param>
        ''' <returns>Cookie值</returns>
        ''' <remarks></remarks>
        Public Function xCookie(ByVal k As String) As String
            Return xCookie(k, String.Empty)
        End Function

        ''' <summary>
        ''' Cookie值(utf8格式)
        ''' </summary>
        ''' <param name="k">key</param>
        ''' <param name="d">默认值</param>
        ''' <returns>Cookie值</returns>
        ''' <remarks></remarks>
        Public Function xCookie(ByVal k As String, ByVal d As String) As String
            Dim ReturnValue As String = d
            If Not Request.Cookies(k) Is Nothing AndAlso Not String.IsNullOrEmpty(Request.Cookies(k).Value) Then
                ReturnValue = HttpUtility.UrlDecode(Request.Cookies(k).Value, Encoding.UTF8)
            End If
            Return ReturnValue
        End Function

        ''' <summary>
        ''' Cookie值(utf8格式)
        ''' </summary>
        ''' <param name="k">key</param>
        ''' <param name="v">value</param>
        ''' <returns>Cookie值</returns>
        ''' <remarks></remarks>
        Public Function xSetCookie(ByVal k As String, ByVal v As String) As String
            Dim c As HttpCookie = Request.Cookies.Item(k)
            If c Is Nothing Then
                c = New HttpCookie(k)
            End If
            c.Value = v
            Response.Cookies.Add(c)
            Return xCookie(k, v)
        End Function


        ''' <summary>
        ''' 读取web.config参数配置
        ''' </summary>
        ''' <param name="k">关健词</param>
        ''' <returns>参数值</returns>
        ''' <remarks></remarks>
        Public Function xConfig(ByVal k As String) As String
            Return xConfig(k, String.Empty)
        End Function


        ''' <summary>
        ''' 读取web.config参数配置,带默认值
        ''' </summary>
        ''' <param name="k">关健词</param>
        ''' <param name="d">默认值</param>
        ''' <returns>参数值</returns>
        ''' <remarks></remarks>
        Public Function xConfig(ByVal k As String, ByVal d As String) As String
            Dim ReturnValue As String = Util.AppSettings(k)
            Try
                If String.IsNullOrEmpty(ReturnValue) Then
                    ReturnValue = d
                End If
            Catch ex As Exception
                ReturnValue = String.Empty
            End Try
            Return ReturnValue
        End Function

        ''' <summary>
        ''' 通行证是否登录
        ''' </summary>
        ''' <returns>true/false</returns>
        ''' <remarks></remarks>
        Public Function xIsLogin() As Boolean
            Return Passport.IsLogin
        End Function

        ''' <summary>
        ''' 发送邮件
        ''' </summary>
        ''' <param name="m">收件人</param>
        ''' <param name="t">标题</param>
        ''' <param name="c">邮件内容</param>
        ''' <returns>返回true成功,返回其他为空</returns>
        ''' <remarks></remarks>
        Public Function xSendMail(ByVal m As String, ByVal t As String, ByVal c As String) As String
            Dim ss As New SmtpSender
            Dim ReturnValue As String = "false"
            Try
                If ss.send(m, t, c, Nothing, System.Net.Mail.MailPriority.Normal, True, Encoding.UTF8) Then
                    Return "true"
                End If
                ReturnValue = ss.ErrMessage
            Catch ex As Exception
                ReturnValue = ex.Message
            End Try
            ss = Nothing
            Return ReturnValue
        End Function

        ''' <summary>
        ''' 发送短信
        ''' </summary>
        ''' <param name="target">目标手机号</param>
        ''' <param name="content">发送的内容</param>
        ''' <returns>发送的结果</returns>
        ''' <remarks></remarks>
        Public Function xSmsSend(ByVal target As String, ByVal content As String) As String
            Return xSmsSend("10", target, content)
        End Function

        ''' <summary>
        ''' 发送短信
        ''' </summary>
        ''' <param name="ac">动作代码</param>
        ''' <param name="target">目标手机号</param>
        ''' <param name="content">发送的内容</param>
        ''' <returns>发送的结果</returns>
        ''' <remarks></remarks>
        Public Function xSmsSend(ByVal ac As String, ByVal target As String, ByVal content As String) As String
            Return xSmsSend(ac, target, content, String.Empty)
        End Function

        ''' <summary>
        ''' 发送短信
        ''' </summary>
        ''' <param name="ac">动作代码</param>
        ''' <param name="target">目标手机号</param>
        ''' <param name="content">发送的内容</param>
        ''' <param name="query">附加的url参数</param>
        ''' <returns>发送的结果</returns>
        ''' <remarks></remarks>
        Public Function xSmsSend(ByVal ac As String, ByVal target As String, ByVal content As String, ByVal query As String) As String
            Dim returnValue As String = String.Empty
            Dim sms As SmsInfo = SmsConfig.Load()
            If sms Is Nothing OrElse sms.Account Is Nothing OrElse String.IsNullOrEmpty(sms.Account.Url) Then
                sms = Nothing
                mSmsErrMessage = "xSmsSend.无此配置信息"
                Return "-500"
            End If
            returnValue = String.Concat(sms.Account.Action, "=", ac)
            returnValue = String.Concat(returnValue, "&", sms.Account.Target, "=", Server.UrlEncode(target))
            returnValue = String.Concat(returnValue, "&", sms.Account.Content, "=", Server.UrlEncode(content))
            Return xSms(returnValue)
        End Function

        ''' <summary>
        ''' http短信服务
        ''' </summary>
        ''' <param name="query">其他参数</param>
        ''' <returns>短信发送结果</returns>
        ''' <remarks></remarks>
        Public Function xSms(ByVal query As String) As String
            Dim sms As SmsInfo = SmsConfig.Load()
            Dim code As String
            Try
                If sms Is Nothing OrElse sms.Account Is Nothing OrElse String.IsNullOrEmpty(sms.Account.Url) Then
                    sms = Nothing
                    mSmsErrMessage = "xSms.无此配置信息"
                    Return "-500"
                End If

                Dim url As String = String.Concat(sms.Account.Url, "?", query, sms.Account.toUrlParam())


                code = Util.GetHtmlFromUrl(url.Trim())

                DebugToLog(String.Concat("SmsUrl=", url.Trim(), ":", code))
                If Not IsNumeric(code) Then
                    mSmsErrMessage = code
                    code = "-500"
                End If
            Catch ex As Exception
                mSmsErrMessage = ex.Message
                xToLog(ex.Message)
                Return "-500"
            End Try

            Return code
        End Function

        ''' <summary>
        ''' 短信错误信息
        ''' </summary>
        ''' <param name="code">错误代码</param>
        ''' <returns>错误信息</returns>
        ''' <remarks></remarks>
        Public Function xSmsErr(ByVal code As String) As String
            If code = "-500" Then
                Return mSmsErrMessage
            End If
            Dim sms As SmsInfo = SmsConfig.Load()
            If sms Is Nothing OrElse sms.Account Is Nothing OrElse String.IsNullOrEmpty(sms.Account.Url) Then
                sms = Nothing
                Return "读取短信配置出错"
            End If

            Return sms.Account.ErrMessage(code)
        End Function

        ''' <summary>
        ''' 站点配置信息
        ''' </summary>
        ''' <param name="name">名称</param>
        ''' <returns>配置值</returns>
        ''' <remarks></remarks>
        Public Function xSiteConfig(name As String) As String
            Return xSiteConfig(name, String.Empty)
        End Function

        ''' <summary>
        ''' 站点配置信息
        ''' </summary>
        ''' <param name="name">名称</param>
        ''' <param name="d">默认值</param>
        ''' <returns>配置值</returns>
        ''' <remarks></remarks>
        Public Function xSiteConfig(name As String, d As String) As String
            If SiteInfo Is Nothing Then
                Return d
            Else
                Dim rtnValue As String = SiteInfo.Item(name)
                If String.IsNullOrEmpty(rtnValue) Then
                    Return d
                Else
                    Return rtnValue
                End If
            End If
        End Function

        ''' <summary>
        ''' 文件是否存在
        ''' </summary>
        ''' <param name="sFileName">文件名</param>
        ''' <returns>是否存在</returns>
        ''' <remarks></remarks>
        Public Function xExists(ByVal sFileName As String) As Boolean
            If String.IsNullOrEmpty(sFileName) Then
                Return False
            End If
            Return (IO.File.Exists(Server.MapPath(sFileName)))
        End Function

        ''' <summary>
        ''' 支付宝通知来源验证
        ''' </summary>
        ''' <param name="notify_id">通知ID</param>
        ''' <returns>是否支付宝来源</returns>
        ''' <remarks></remarks>
        Public Function xAlipayVerify(ByVal notify_id As String) As String
            Dim rtnValue As String
            Try
                rtnValue = PaymentConfigInfo.Alipay.Verify(notify_id)
            Catch ex As Exception
                rtnValue = ex.Message
            End Try
            Return rtnValue
        End Function

        ''' <summary>
        ''' 验证支付宝签名
        ''' </summary>
        ''' <param name="mode"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xSignFromAlipay(ByVal mode As String) As String
            Return SignFromAlipay(mode)
        End Function

        ''' <summary>
        ''' 验证支付宝签名
        ''' </summary>
        ''' <param name="mode">post/get</param>
        ''' <param name="sign">传过来的签名</param>
        ''' <returns>是否验证通过</returns>
        ''' <remarks></remarks>
        Public Function xAlipayVerifySign(ByVal mode As String, ByVal sign As String) As Boolean
            Dim rtnValue As String = SignFromAlipay(mode)
            Return rtnValue = sign
        End Function


        ''' <summary>
        ''' 生成支付宝表单
        ''' </summary>
        ''' <param name="out_trade_no">请与贵网站订单系统中的唯一订单号匹配</param>
        ''' <param name="subject">订单名称，显示在支付宝收银台里的“商品名称”里，显示在支付宝的交易管理的“商品名称”的列表里。</param>
        ''' <param name="body">订单描述、订单详细、订单备注，显示在支付宝收银台里的“商品描述”里</param>
        ''' <param name="total_fee">订单总金额，显示在支付宝收银台里的“应付总额”里</param>
        ''' <param name="mode">生成表单的提交方式 post/get</param>
        ''' <returns>表单的html</returns>
        ''' <remarks></remarks>
        Public Function xAlipayForm(ByVal out_trade_no As String, ByVal subject As String, ByVal body As String, ByVal total_fee As String, ByVal mode As String) As String
            If PaymentConfigInfo.Alipay Is Nothing Then
                Return "无法加载支付宝配套文件"
            End If

            If PaymentConfigInfo.Alipay.enabled Then
                Dim alipay As Payment.AlipayConfigInfo = PaymentConfigInfo.Alipay
                '''''''''''''''''''''''以下参数是需要通过下单时的订单数据传入进来获得''''''''''''''''''''''''''''''
                '必填参数
                alipay.out_trade_no = out_trade_no    '请与贵网站订单系统中的唯一订单号匹配
                alipay.subject = subject              '订单名称，显示在支付宝收银台里的“商品名称”里，显示在支付宝的交易管理的“商品名称”的列表里。
                alipay.body = body                    '订单描述、订单详细、订单备注，显示在支付宝收银台里的“商品描述”里
                alipay.total_fee = total_fee          '订单总金额，显示在支付宝收银台里的“应付总额”里

                '扩展功能参数——网银提前

                Dim pay_mode As String = Request.Form("pay_bank")
                If pay_mode = "directPay" Then
                    alipay.paymethod = "directPay"
                Else
                    alipay.paymethod = "bankPay"
                    alipay.defaultbank = pay_mode
                End If

                Return alipay.BuildForm(mode)
            Else
                Return "系统未启用开支付宝支付功能"
            End If
        End Function

        ''' <summary>
        ''' 生成支付宝表单
        ''' </summary>
        ''' <param name="out_trade_no">请与贵网站订单系统中的唯一订单号匹配</param>
        ''' <param name="subject">订单名称，显示在支付宝收银台里的“商品名称”里，显示在支付宝的交易管理的“商品名称”的列表里。</param>
        ''' <param name="body">订单描述、订单详细、订单备注，显示在支付宝收银台里的“商品描述”里</param>
        ''' <param name="total_fee">订单总金额，显示在支付宝收银台里的“应付总额”里</param>
        ''' <returns>表单的html</returns>
        ''' <remarks></remarks>
        Public Function xAlipayForm(ByVal out_trade_no As String, ByVal subject As String, ByVal body As String, ByVal total_fee As String) As String
            Return xAlipayForm(out_trade_no, subject, body, total_fee, "get")
        End Function

        ''' <summary>
        ''' 返回支付宝通知的状态
        ''' </summary>
        ''' <returns>success/fail/无通知参数</returns>
        ''' <remarks></remarks>
        Public Function xAlipayNotify() As Boolean
            ''''''''''''''''''''''''以下参数是需要设置的相关配置参数，设置后不会更改的'''''''''''''''''''''''''

            Dim sArray As String() = GetRequestPost()

            If sArray.Length > 0 Then   '判断是否有带返回参数

                Dim notify_id As String = Request.Form("notify_id")
                Dim responseTxt = xAlipayVerify(notify_id)

                Dim sign As String = Request.Form("sign")           '获取支付宝反馈回来的sign结果
                Dim mysign As String = SignFromAlipay("post")           '获取通知返回后计算后（验证）的签名结果

                '写调试日志记录（若要调试，请把支付方式 debug=true）
                If PaymentConfigInfo.Alipay.debug Then
                    Dim PreSignStr As String = Payment.Alipay.Util.create_linkstring(sArray)
                    Dim sWord As New StringBuilder
                    sWord.AppendLine("------------" & notify_id & "-------------")
                    sWord.AppendLine("通知返回时间=" & Now.ToString())
                    sWord.AppendLine("通知验证结果=" & responseTxt)
                    sWord.AppendLine("返回的签名=" & sign)
                    sWord.AppendLine("回来的参数签名=" & mysign)
                    sWord.AppendLine("回来的参数：" & PreSignStr)
                    sWord.AppendLine("----------------------  End  ---------------------")
                    Util.toLog(Server.MapPath("/log/" & DateTime.Now.ToString("yyyyMMdd") & ".txt"), sWord.ToString())
                End If

                If responseTxt = "true" And sign = mysign Then    '验证成功

                    If Request.Form("trade_status") = "TRADE_FINISHED" Or Request.Form("trade_status") = "TRADE_SUCCESS" Then
                        '判断该笔订单是否在商户网站中已经做过处理（可参考“集成教程”中“3.4返回数据处理”）
                        '如果没有做过处理，根据订单号（out_trade_no）在商户网站的订单系统中查到该笔订单的详细，并执行商户的业务程序
                        '如果有做过处理，不执行商户的业务程序
                        '请不要修改或删除
                        Response.Clear()
                        Response.Write("success")       '请不要修改或删除
                        Return True
                    Else
                        Response.Clear()
                        Response.Write("fail")          '请不要修改或删除
                        Return False
                    End If
                    '——请根据您的业务逻辑来编写程序（以上代码仅作参考）——

                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Else    '验证失败
                    Response.Clear()
                    Response.Write("fail")              '请不要修改或删除
                    Return False
                End If
            Else
                Response.Clear()
                Response.Write("无通知参数")           '请不要修改或删除
                Return False
            End If

        End Function


        ''' <summary>
        ''' 压缩字符串
        ''' </summary>
        ''' <param name="str">非压缩的字符串</param>
        ''' <returns>压缩后字符串</returns>
        ''' <remarks></remarks>
        Public Function xZip(ByVal str As String) As String
            Dim ReturnValue As String
            ReturnValue = Common.Util.ZipString(str)
            If String.IsNullOrEmpty(ReturnValue) Then
                Return str
            Else
                Return ReturnValue
            End If
        End Function

        ''' <summary>
        ''' 解压字符串
        ''' </summary>
        ''' <param name="str">压缩后的字符串</param>
        ''' <returns>非压缩的字符串</returns>
        ''' <remarks></remarks>
        Public Function xUnZip(ByVal str As String) As String
            Dim ReturnValue As String
            ReturnValue = Common.Util.UnzipString(str)
            If String.IsNullOrEmpty(ReturnValue) Then
                Return str
            Else
                Return ReturnValue
            End If
        End Function

        ''' <summary>
        ''' 写入日志(/debug.log)
        ''' </summary>
        ''' <param name="sWord"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xToLog(ByVal sWord As String) As Boolean
            Return Util.toLog(Server.MapPath("/debug.log"), sWord)
        End Function

        ''' <summary>
        ''' 默认编码utf-8读取远程数据
        ''' </summary>
        ''' <param name="url"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xHttpGet(url As String) As String
            Return xHttpGet(url, "utf-8")
        End Function


        ''' <summary>
        ''' split 分拆成xpath
        ''' </summary>
        ''' <param name="f"></param>
        ''' <param name="c"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xXmlSplit(ByVal f As String, ByVal c As String) As System.Xml.XPath.XPathNavigator
            Dim a As String() = Regex.Split(f, c, RegexOptions.IgnoreCase)
            Try
                Dim ser As New System.Xml.Serialization.XmlSerializer(a.GetType(), New System.Xml.Serialization.XmlRootAttribute("array"))
                Dim mem As New IO.MemoryStream
                ser.Serialize(mem, a)
                Dim xmlstr As String = Encoding.UTF8.GetString(mem.ToArray())
                mem.Close()
                mem = Nothing
                Dim doc As New System.Xml.XmlDocument()
                doc.LoadXml(xmlstr)
                Return doc.CreateNavigator
            Catch ex As Exception
                xToLog(ex.ToString())
                Return xmlpath("<array/>")
            End Try

        End Function

        Public Function xmlpath(rootName As String) As System.Xml.XPath.XPathNavigator
            Dim doc As New System.Xml.XmlDocument()
            doc.LoadXml(rootName)
            Return doc.CreateNavigator
        End Function


        ''' <summary>
        ''' 读取远程数据
        ''' </summary>
        ''' <param name="url">远程链接</param>
        ''' <param name="charset">编码</param>
        ''' <returns>远程返回的数据</returns>
        ''' <remarks></remarks>
        Public Function xHttpGet(url As String, charset As String) As String
            Dim web As New Net.HttpClient
            Dim bytes As Byte() = web.DownloadData(url)
            Dim content As String = Encoding.GetEncoding(charset).GetString(bytes)
            web.Dispose()
            web = Nothing
            Return content
        End Function


        ''' <summary>
        ''' 动态加载页面
        ''' </summary>
        ''' <param name="spName">存储过程</param>
        ''' <param name="params">参数</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xExec(spName As String, params As String) As System.Xml.XPath.XPathNavigator
            params = String.Concat("|", params)
            Dim xpath As System.Xml.XPath.XPathDocument
            If DataBase.ExecuteProduce(spName, params.Split(CChar("|")), xpath) = -500 Then
                Dim doc As New System.Xml.XmlDocument
                doc.LoadXml("<rows/>")
                xToLog(DataBase.ErrMessage)
                Return doc.CreateNavigator()
            End If

            Return xpath.CreateNavigator()
        End Function


        ''' <summary>
        ''' 动态加载
        ''' </summary>
        ''' <param name="fnKey"></param>
        ''' <param name="fnCacheMinute"></param>
        ''' <param name="fnParam"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function xLoadXml(ByVal fnKey As String, ByVal fnCacheMinute As Integer, ByVal fnParam As String) As System.Xml.XPath.XPathNavigator

            Dim fnStartTime As DateTime = DateTime.Now
            Dim fnOutHtml As String = String.Empty
            Dim strOrderby As String = String.Empty
            Dim iRowCount As Long = 0
            Dim ListItem As LabelItem = LabelInfo.Find(fnKey)

            Dim xPathDoc As System.Xml.XPath.XPathDocument = Nothing
            Dim iMaxRowEveryPage As Integer = 0
            Dim strWhere As String = String.Empty

            If ListItem Is Nothing Then
                Return Nothing
            End If

            REM 检查权限
            If Not String.IsNullOrEmpty(ListItem.ACL) Then
                Dim Err As String = String.Empty
                If Not ChkLabelItemACL(ListItem.ACL, fnKey, Err) Then
                    Return Nothing
                End If
            End If

            If String.IsNullOrEmpty(ListItem.Paramaters) And Not ListItem.Table Is Nothing Then

                Select Case ListItem.Table.type

                    Case "function"

                        Dim SqlParams() As System.Data.Common.DbParameter = GetStroeProcParam(ListItem.Table.Param, fnParam)

                        Dim functionReturn As String = DataBase.ExecuteFunction(ListItem.Table.Name, SqlParams)
                        If functionReturn.StartsWith("-500.") Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                            Return Nothing
                        Else
                            Return Nothing
                        End If

                    Case "proc"

                        Dim SqlParams() As System.Data.Common.DbParameter = GetStroeProcParam(ListItem.Table.Param, fnParam)
                        If DataBase.ExecuteProduce(ListItem.Table.Name, SqlParams, xPathDoc) = -500 Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))

                            Return Nothing
                        End If

                    Case "table"
                        Dim TableName As String = ListItem.Table.Name
                        Dim Query As String = ListItem.Table.Query

                        strWhere = GetTableWhere(ListItem.Table.Where, fnParam)

                        DebugToLog(String.Concat("where -", ListItem.Name, strWhere))

                        strOrderby = ListItem.Table.OrderBy

                        If Not String.IsNullOrEmpty(ListItem.Variables) Then
                            ReplaceRequestString(strOrderby)
                            InputVariables(strOrderby, ListItem.Variables)
                        End If
                        If Not String.IsNullOrEmpty(ListItem.Table.MaxOnPage) Then
                            Dim mR As String = ListItem.Table.MaxOnPage
                            ReplaceRequestString(mR)
                            iMaxRowEveryPage = CInt(mR)
                        End If

                        iRowCount = DataBase.XQuery(TableName, iMaxRowEveryPage, PageNumber, Query, strOrderby, strWhere, xPathDoc)
                        If iRowCount < 0 Then
                            DebugToLog(String.Concat("-500", ListItem.Name, DataBase.ErrMessage))
                            Return Nothing
                        End If
                    Case Else

                        Return Nothing
                End Select
            Else

                If String.IsNullOrEmpty(ListItem.Paramaters) Then
                    Return Nothing
                End If

                REM 加载页面请求的参数
                ReplaceRequestString(ListItem.Paramaters)

                If Not String.IsNullOrEmpty(ListItem.Variables) Then
                    ReplaceRequestString(ListItem.Variables)
                    REM 替换所定义的变量值 $X
                    InputVariables(ListItem.Paramaters, ListItem.Variables)
                End If


                Dim aParamaters() As String = Split(CheckParamaters(ListItem.Paramaters, fnParam), "|")

                Dim QueryTable As String = aParamaters(0)


                REM 读取缓存处理
                Dim CacheName As String = String.Format("{0}_{1}", Replace(ListItem.Paramaters, " ", "_"), PageNumber)
                Dim CacheComment As String

                If fnCacheMinute > 0 AndAlso Not Cache(CacheName) Is Nothing Then
                    xPathDoc = CType(Cache(CacheName), System.Xml.XPath.XPathDocument)
                    CacheComment = String.Format("<!--读取CACHE({0})-time({1})-->", CacheName, fnCacheMinute)
                Else

                    If aParamaters.Length > 4 Then
                        strWhere = aParamaters(4)
                    End If
                    Try
                        Dim RuleString As String = "^{SP:([a-zA-Z_0-9._]+)}"
                        If Regex.IsMatch(QueryTable, RuleString, RegexOptions.IgnoreCase) Then '判断是否为存储过程
                            DataBase.ExecuteProduce(Regex.Match(QueryTable, RuleString, RegexOptions.IgnoreCase).Groups.Item(1).Value(), aParamaters, xPathDoc)
                        Else
                            If Not IsNumeric(aParamaters(1)) Then
                                Return Nothing
                            End If
                            iRowCount = DataBase.XQuery(QueryTable.Trim(), CType(aParamaters(1), Integer), PageNumber, aParamaters(2).ToString, aParamaters(3).ToString, strWhere, xPathDoc)
                            If iRowCount = -500 Then
                                Return Nothing
                            End If
                            iMaxRowEveryPage = CType(aParamaters(1), Integer)
                            strOrderby = aParamaters(3).ToString
                        End If
                    Catch ex As Exception
                        DebugToLog(String.Concat("500", ListItem.Name, ex.Message))
                        Return Nothing
                    End Try

                End If

            End If

            Return xPathDoc.CreateNavigator()

        End Function
#End Region


#Region "认证站点转向URL功能"

        Protected Overridable Sub redirectTokenUrl()
            If Not String.IsNullOrEmpty(AppConfigInfo.PassportGetTokenPage) Then
                Response.Redirect(getTokenURL(AppConfigInfo.PassportGetTokenPage))
            End If
        End Sub


        Protected Function getTokenURL(ByVal tokenPage As String) As String
            Dim getokenUrl As New UriBuilder(tokenPage)

            Dim url As String = AbsoluteUri

            url = Regex.Replace(url, "(\?|&)Token=[^&]*", "", RegexOptions.IgnoreCase)

            If Regex.IsMatch(url, "^.*\?.+=.+$", RegexOptions.IgnoreCase) Then
                url += "&Token=$Token$"
            Else
                url += "?Token=$Token$"
            End If

            getokenUrl.Query = "toUrl=" + Server.UrlEncode(url)

            Return getokenUrl.ToString
        End Function

        Protected Overridable Function replaceToken() As String
            Dim url As String = Request.Url.AbsoluteUri
            url = Regex.Replace(url, "(\?|&)Token=[^&]*", "", RegexOptions.IgnoreCase)
            Return String.Concat(AppConfigInfo.PassportLoginPage, "?", "toUrl=" + Server.UrlEncode(url))
        End Function
#End Region


        ''' <summary>
        ''' 加载主站认证
        ''' </summary>
        ''' <param name="tokenValue">令牌</param>
        ''' <returns>true/false</returns>
        ''' <remarks></remarks>
        Protected Overridable Function LoadToken(ByVal tokenValue As String) As Boolean
            Dim returnValue As Boolean = False
            If Not String.IsNullOrEmpty(tokenValue) Then '持有令牌

                '调用WebService获取主站凭证
                Dim tokenService As passport.net.TokenService = New passport.net.TokenService
                Dim tokenInfo As String = CStr(tokenService.TokenGetCredence(tokenValue))
                If Not String.IsNullOrEmpty(tokenInfo) Then
                    mPassport = CType(JavaScriptConvert.DeserializeObject(tokenInfo, GetType(PassportInfo)), PassportInfo)
                    If Not mPassport Is Nothing AndAlso mPassport.IsLogin Then
                        '令牌正确 授权访问该页面！
                        Return SavePassportCookie(tokenInfo)
                    End If

                End If
            End If

            Return False
        End Function

        ''' <summary>
        ''' 从支付定过来Post/Get参数生成的签名
        ''' </summary>
        ''' <param name="mode">Post/Get</param>
        ''' <returns>生成的签名结果</returns>
        ''' <remarks></remarks>
        Protected Function SignFromAlipay(Optional ByVal mode As String = "post") As String
            Dim sArray As String()
            If LCase(mode) = "post" Then
                sArray = GetRequestPost()
            Else
                sArray = GetRequestGet()
            End If
            Return PaymentConfigInfo.Alipay.getSignFromParams(sArray)
        End Function

        ''' <summary>
        ''' 获取支付宝GET过来通知消息，并以“参数名=参数值”的形式组成数组
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks>request回来的信息组成的数组</remarks>
        Protected Function GetRequestGet() As String()
            Dim sArray As String() = {}
            Dim i As Integer
            Dim coll As NameValueCollection
            'Load Form variables into NameValueCollection variable.
            coll = Request.QueryString
            ' Get names of all forms into a string array
            Dim requestItem As String() = coll.AllKeys

            For i = 0 To requestItem.Length - 1
                ReDim Preserve sArray(i)
                sArray(i) = requestItem(i) & "=" & Request.QueryString(requestItem(i))
            Next

            Return sArray
        End Function

        ''' <summary>
        ''' 获取支付宝POST过来通知消息，并以“参数名=参数值”的形式组成数组 
        ''' </summary>
        ''' <returns>request回来的信息组成的数组</returns>
        ''' <remarks></remarks>
        Protected Function GetRequestPost() As String()
            Dim sArray As String() = {}
            Dim i As Integer
            Dim coll As NameValueCollection
            'Load Form variables into NameValueCollection variable.
            coll = Request.Form
            ' Get names of all forms into a string array
            Dim requestItem As String() = coll.AllKeys

            For i = 0 To requestItem.Length - 1
                ReDim Preserve sArray(i)
                sArray(i) = requestItem(i) & "=" & Request.Form(requestItem(i))
            Next

            Return sArray
        End Function

        ''' <summary>
        ''' 调用页面压缩功能
        ''' </summary>
        ''' <remarks></remarks>
        Protected Sub CallCompression()

            Dim type As CompressType = GetCompressType()
            If type = CompressType.GZip Then
                Response.Filter = New IO.Compression.GZipStream(Response.Filter, IO.Compression.CompressionMode.Compress)
                Response.AppendHeader("Content-Encoding", type.ToString().ToLower())
            ElseIf type = CompressType.Deflate Then
                Response.Filter = New IO.Compression.DeflateStream(Response.Filter, IO.Compression.CompressionMode.Compress)
                Response.AppendHeader("Content-Encoding", type.ToString().ToLower())
            End If
        End Sub

        ''' <summary>
        ''' 获得客户端的压缩类型
        ''' </summary>
        ''' <returns>CompressType</returns>
        ''' <remarks></remarks>
        Protected Function GetCompressType() As CompressType
            Dim accept As String = Request.Headers("Accept-Encoding")
            If String.IsNullOrEmpty(accept) Then
                Return CompressType.None
            End If
            accept = accept.ToUpperInvariant()
            If accept.Contains("GZIP") Then
                Return CompressType.GZip
            End If
            If accept.Contains("DEFLATE") Then
                Return CompressType.Deflate
            End If
            Return CompressType.None
        End Function

        ''' <summary>
        ''' 压缩类型        ''' 
        ''' </summary>
        ''' <remarks></remarks>
        Protected Enum CompressType
            ''' <summary>
            ''' GZIP压缩
            ''' </summary>
            GZip
            ''' <summary>
            ''' Deflate压缩
            ''' </summary>
            Deflate
            ''' <summary>
            ''' 不支持压缩
            ''' </summary>
            None
        End Enum
    End Class


End Namespace